home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / 172bbas.zip / RBBSSUB5.BAS < prev   
BASIC Source File  |  1989-07-26  |  79KB  |  2,437 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB5.BAS CPC17.2B, Copyright 1986 - 89 by D. Thomas Mack'
  3. '  Copyright 1989 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB5.BAS
  5. '  Written by .........: D. Thomas Mack
  6. '  First Released .....: May 28, 1989
  7. '  Subsequent Releases.: 07-30-89
  8. '  Copyright ..........: 1986 - 1989
  9. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  10. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  11. '     require error trapping are incorporated within RBBSSUB 2-5 as
  12. '     separately callable subroutines in order to free up as much
  13. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  14. '  Parameters..........: Most parameters are passed via a COMMON statement.
  15. '
  16. ' Subroutine  Line               Function of Subroutine
  17. '   Name     Number
  18. '  BRKFNAME   63300   Break file name into component parts
  19. '  BUFASUNIT  63500   Buffer out a string with CR's
  20. '  CALLOPT    63470   Set prompts based on the user's security
  21. '  DOORRTN    63100   Process door requests
  22. '  FILESYS    20117   File System for RBBS-PC
  23. '  FINDIT             Check whether file exists and if so open as #2
  24. '  FORMREAD   63420   Read from file into a form
  25. '  LOCKAPPND  63400   Prepare for a file append
  26. '  MACROEXE   63460   Execute internal macro rather than user
  27. '  NOPATH     63480   Detects whether string has a path in it
  28. '  RESTORECOM 63310   Restore comm port after external program
  29. '  READMACRO  63330   Read and process macro
  30. '  SHELLEXIT  63320   Exit RBBS via shell
  31. '  UNLKAPPND  63410   Clean up after file append
  32. '  WILDCARD   63200   Match string to a pattern
  33. '
  34. '  $INCLUDE: 'RBBS-VAR.BAS'
  35. '
  36. 20117 ' $SUBTITLE: 'FILESYS -- subroutine for RBBS-PC's file system'
  37. ' $PAGE
  38. '
  39. ' NAME    -- FILESYS
  40. '
  41. ' INPUTS  --       PARAMETER                 MEANING
  42. '             FILESYS.PARAMETER = 1  LIST THE SYSOP'S COMMENTS FILE
  43. '                                 2  L)IST DIRECTORY COMMAND
  44. '                                 3  D)OWNLOAD COMMAND
  45. '                                 4  RETURN FROM EXTERNAL PROTOCOLS
  46. '                                 5  U)PLOAD COMMAND
  47. '                                 6  S)CAN DIRECTORY COMMAND
  48. '                                 7  P)ERSONAL FILES COMMAND
  49. '                                 8  N)EW FILES COMMAND
  50. '                                 9  RETURN FROM EXTENDED DESCRIPTION
  51. '
  52. ' OUTPUTS -- FILESYS.PARAMETER = 1  COMMAND PROCESSED SUCCESSFULLY
  53. '                                2  RECYCLE TO TOP OF RBBS-PC (202)
  54. '                                3  PROCESS NEXT COMMAND (1200)
  55. '                                4  DENY USER ACCESS (1380)
  56. '                                5  HANDLE EXTENDED DESCRIP. (2008)
  57. '                                6  USER'S TIME EXCEEDED (10553)
  58. '                                7  CARRIER DROPPED (10595)
  59. '
  60. ' PURPOSE -- To handle the RBBS-PC file system commands
  61. '
  62.       SUB FILESYS STATIC
  63.       FF = FILESYS.PARAMETER
  64.       FILESYS.PARAMETER = 1
  65.       ON FF GOSUB 20119, _  ' HANDLER TO LIST COMMENTS TO SYSOP
  66.                   20150, _  ' L)IST DIRECTORY COMMAND HANDLER
  67.                   20180, _  ' D)OWNLOAD COMMAND HANDLER
  68.                   20262, _  ' RETURN FROM EXTERNAL PROTOCOL'S
  69.                   20400, _  ' U)PLOAD COMMAND HANDLER
  70.                   21800, _  ' S)CAN DIRECTORY COMMAND HANDLER
  71.                   21850, _  ' P)ERSONAL FILES COMMAND HANDLER
  72.                   21860, _  ' N)EW FILES COMMAND HANDLER
  73.                   20705     ' RETURN FROM EXTENDED DESCRIPTIONS
  74.       GOTO 21920
  75. 20119 EC = 0
  76.       GOTO 20122
  77. '
  78. ' *****  SCAN DIRECTORIES (PRINT TEXT)  ****
  79. '
  80. '  (formerly lines 7000 to 7260 in RBBS-PC.BAS CPC16-1A
  81. 20120 A$ = "Scanning Directory " + _
  82.            FILE.NAME.HOLD$ + _
  83.            " for " + _
  84.            RS$
  85.       GOSUB 21650
  86.       IF FILESYS.PARAMETER > 1 THEN _
  87.          RETURN
  88.       PG = TRUE
  89. 20122 CALL OPENWORK (2,FILE.NAME$)
  90.       IF EC = 53 THEN _
  91.          CALL UPDTCALR ("Missing File " + FILE.NAME$,2) : _
  92.          A$ = "Missing file " + _
  93.               FILE.NAME$ + _
  94.               ". Please tell SYSOP" : _
  95.          GOSUB 21650 : _
  96.          RETURN
  97. 20124 CALL CARRIER
  98.       IF EOF(2) OR _
  99.          (SUBROUTINE.PARAMETER = -1 AND NOT LOCAL.USER) THEN _
  100.          GOTO 20142
  101. 20126 CALL READDIR (2,1)
  102.      IF EC <> 0 THEN _
  103.         EL = 20126 : _
  104.         GOTO 21900
  105.      IF CK = 0 THEN _
  106.         GOTO 20140
  107.      IF LEN(A$) > 0 THEN IF ASC(A$) = 32 THEN _
  108.         IF LAST.OK AND NOT EXTENDED.OFF THEN _
  109.            GOTO 20140 _
  110.         ELSE GOTO 20124
  111.      LAST.OK = FALSE
  112. 20128 IF CK > 1 THEN _
  113.          IF WILD.SEARCH THEN _
  114.             A = INSTR(A$," ") : _
  115.             IF A = 0 THEN _
  116.                GOTO 20124 _
  117.             ELSE Z$ = LEFT$(A$,A - 1) : _
  118.                  CALL WILDFILE (RS$,Z$,XXX) : _
  119.                  GOTO 20136_
  120.          ELSE Z$ = A$ : _
  121.               CALL ALLCAPS (Z$) : _
  122.               XXX = (INSTR(Z$,RS$) = 0) : _
  123.               GOTO 20136
  124. 20130 A = INSTR(9,MID$(A$,1,32),"/")
  125.       IF A = 0 THEN _
  126.          A = INSTR(9,MID$(A$,1,32),"-")
  127. 20132 IF A < 3 THEN _
  128.          GOTO 20124
  129.       IF INSTR("0123456789",MID$(A$,A - 1,1)) = 0 THEN _
  130.          GOTO 20124
  131.       A = A - 2
  132.       WK$ = RIGHT$(MID$(A$,A,8),2) + _
  133.             LEFT$(MID$(A$,A,8),2) + _
  134.             MID$(MID$(A$,A,8),4,2)
  135.       IF MID$(WK$,3,1) = " " THEN _
  136.          MID$(WK$,3,1) = "0"
  137.       IF MID$(WK$,5,1) = " " THEN _
  138.          MID$(WK$,5,1) = "0"
  139. 20134 XXX = (WK$ < RS$)
  140. 20136 IF XXX THEN _
  141.          GOTO 20124
  142.       IF PG THEN _
  143.          PG = FALSE : _
  144.          CALL OPENWORK (2,FILE.NAME$) : _
  145.          Q = 0 : _
  146.          GOTO 20124
  147. 20138 IF PG THEN _
  148.          GOTO 20124
  149. 20140 LAST.OK = TRUE
  150.       GOSUB 21650
  151.       IF FILESYS.PARAMETER > 1 THEN _
  152.          RETURN
  153.       CALL ASKMORE ("",TRUE,TRUE,LIST.INDEX,FALSE)
  154.       IF NO THEN _
  155.          EC = 0 : _
  156.          RETURN
  157.       IF NOT RET THEN _
  158.          GOTO 20124
  159. 20142 Q = 0
  160.       CLOSE 2
  161.       CALL CARRIER
  162.       IF SUBROUTINE.PARAMETER = -1 THEN _
  163.          FILESYS.PARAMETER = 7
  164.       RETURN
  165. '
  166. ' *  L - COMMAND FROM FILES MENU (LIST DIRECTORY)
  167. '
  168. 20150 LIST.DIRECTORY = TRUE
  169.       LIST.NEW = FALSE
  170.       SEARCH.DATE$ = ""
  171.       SEARCH.STRING$ = ""
  172.       SEARCHING.ALL = FALSE
  173.       SHOW.DIR.OF.DIR = NOT EXPERT.USER
  174.       CK = 0
  175.       IF Q > 1 THEN _
  176.          CALL ALLCAPS (B$(2)) : _
  177.          IF B$(2) = "L" THEN _
  178.             SHOW.DIR.OF.DIR = TRUE _
  179.          ELSE LIST.INDEX = 2 : _
  180.               GOTO 20159
  181. 20158 IF LIST.NEW OR LIST.INDEX > 255 THEN _
  182.          LIST.INDEX = 0 : _
  183.          RETURN
  184.       LIST.INDEX = 1
  185.       CALL GETDIRS (SHOW.DIR.OF.DIR)
  186.       IF Q = 0 THEN _
  187.          RETURN
  188.       SHOW.DIR.OF.DIR = FALSE
  189. 20159 CALL CONVDIRS (LIST.INDEX)
  190.       QX = Q
  191. 20160 CALL CARRIER
  192.       IF SUBROUTINE.PARAMETER = -1 THEN _
  193.          FILESYS.PARAMETER = 7 : _
  194.          RETURN
  195.       IF LIST.INDEX <= QX THEN _
  196.          GOTO 20161
  197.       IF NO OR (FILE.NAME.HOLD$ = DIRECTORY.PREFIX$) THEN _
  198.          REDIM A$(ADIM) : _
  199.          REDIM B$(ADIM) : _
  200.          GOTO 20158
  201.       CALL QTPUT (EMPHASIZE.OFF$,0)
  202.       A$ = "End list.  R)elist, [Q]uit, or download what"
  203.       GOSUB 21660
  204.       IF FILESYS.PARAMETER > 1 THEN _
  205.          RETURN
  206.       CALL ALLCAPS (B$(1))
  207.       IF B$(1) = "R" THEN _
  208.          LIST.INDEX = LIST.INDEX - 1 : _
  209.          B$(LIST.INDEX) = A1$ : _
  210.          GOTO 20161
  211.       IF LEN(B$(1)) > 1 AND _
  212.          USER.SECURITY.LEVEL >= OPT.SEC(19 - 20 * (MENU.INDEX = 6)) THEN _
  213.          B = 1 : _
  214.          GOSUB 20202 : _
  215.          IF FILESYS.PARAMETER > 1 THEN _
  216.             RETURN _
  217.          ELSE CALL LINE25
  218.       GOTO 20158
  219. 20161 IF INSTR(B$(LIST.INDEX),".") THEN _
  220.          GOTO 20172
  221.       VIOLATION$ = "List Dir. "
  222.       Z$ = B$(LIST.INDEX)
  223.       A = INSTR("E+E-E",Z$)
  224.       IF A > 0 THEN _
  225.          IF A = 5 THEN _
  226.             EXTENDED.OFF = NOT EXTENDED.OFF : _
  227.             GOTO 20175 _
  228.          ELSE EXTENDED.OFF = (A > 2) : _
  229.               GOTO 20175
  230.       CALL ALLCAPS(Z$)
  231.       FILE.NAME.HOLD$ = Z$
  232.       A1$ = Z$
  233.       IF Z$ = DIRECTORY.PREFIX$ THEN _
  234.          GOTO 20164
  235.       IN.FMS = FALSE
  236. 20162 FOR I = 2 TO QX
  237.          A$(I) = B$(I)
  238.       NEXT
  239.       CALL FMS (Z$,SEARCH.STRING$,SEARCH.DATE$,IN.FMS, _
  240.                 CATEGORY.NAME$(),CATEGORY.CODE$(),CATEGORY.DESC$(),_
  241.                 DOWNLOAD.FLAG,CAT.FOUND,LIST.INDEX)
  242.       WHILE DOWNLOAD.FLAG > 0 AND SUBROUTINE.PARAMETER > -1
  243.          B = 1
  244.          GOSUB 20202
  245.          IF FILESYS.PARAMETER > 1 THEN _
  246.             RETURN
  247.          X$ = CATEGORY.CODE$(CAT.FOUND)
  248.          CALL DISUPDIR (X$,SEARCH.STRING$,SEARCH.DATE$,DOWNLOAD.FLAG,LIST.INDEX)
  249.          CALL CHKTREMAIN (TIME.REMAINING!)
  250.          IF SUBROUTINE.PARAMETER = -1 THEN _
  251.             FILESYS.PARAMETER = 6 : _
  252.             RETURN
  253.          CALL CARRIER
  254.       WEND
  255.       IF SUBROUTINE.PARAMETER = -1 THEN _
  256.          FILESYS.PARAMETER = 7 : _
  257.          RETURN
  258.       FOR I = 2 TO QX
  259.          B$(I) = A$(I)
  260.       NEXT
  261.       ACTIVE.FMS.DIRECTORY$ = ""
  262.       IF IN.FMS THEN _
  263.          GOTO 20175
  264.       IF USER.SECURITY.LEVEL < MIN.SEC.TO.VIEW THEN _
  265.          IF FILE.NAME.HOLD$ = UPLOAD.DIR.CHECK$ THEN _
  266.             FILE.NAME.HOLD$ = "of uploads" : _
  267.             GOTO 20172
  268.       FILE.NAME.HOLD$ = B$(LIST.INDEX)
  269.       IF LIMIT.SEARCH.TO.FMS THEN _
  270.          GOTO 20166
  271.       IF FILE.NAME.HOLD$ = "ALL" OR FILE.NAME.HOLD$ = "A" THEN _
  272.          SEARCHING.ALL = TRUE : _
  273.          DIR.INDEX = LIST.INDEX : _
  274.          GOTO 21890
  275.       CALL BADFILE (FILE.NAME.HOLD$,BAD.FILE.NAME.INDEX)
  276.       ON BAD.FILE.NAME.INDEX GOTO 20163,20172,20176
  277. 20163 FILE.NAME$ = FILE.NAME.HOLD$
  278.       CALL BADNAME (BAD.FILE.NAME.INDEX)
  279.       ON BAD.FILE.NAME.INDEX GOTO 20164,20176
  280. 20164 IF FILE.NAME$ = UPLOAD.DIR.CHECK$ AND _
  281.          USER.SECURITY.LEVEL >= MIN.SEC.TO.VIEW THEN _
  282.             FILE.NAME$ = UPLOAD.PATH$ _
  283.       ELSE FILE.NAME$ = DIRECTORY.PATH$
  284.       FILE.NAME$ = FILE.NAME$ + _
  285.                    FILE.NAME.HOLD$ + _
  286.                    "." + _
  287.                    DIRECTORY.EXTENTION$
  288.       CALL GRAPHIC (USER.GRAPHIC.DEFAULT$,FILE.NAME$)
  289. 20165 IF OK THEN _
  290.          CALL READDIR (2,1) : _
  291.          IF EC = 0 THEN _
  292.             IF LEFT$(A$,4) = "\FMS" THEN _
  293.                IN.FMS = TRUE : _
  294.                ACTIVE.FMS.DIRECTORY$ = FILE.NAME$ : _
  295.                GOTO 20162 _
  296.             ELSE GOTO 20167
  297. 20166 FILE.NAME$ = DIRECTORY.PATH$ + _
  298.                    FILE.NAME.HOLD$ + ".MNU"
  299.       CALL FINDIT (FILE.NAME$)
  300.       IF OK THEN _
  301.          CALL BUFFILE (FILE.NAME$,LIST.INDEX) : _
  302.          GOTO 20158
  303.       IF ALTDIR.EXTENSION$ = "" THEN _
  304.          GOTO 20172
  305.       FILE.NAME$ = DIRECTORY.PATH$ + _
  306.                    FILE.NAME.HOLD$ + _
  307.                    "." + _
  308.                    ALTDIR.EXTENSION$
  309.       CALL GRAPHIC (USER.GRAPHIC.DEFAULT$,FILE.NAME$)
  310.       IF NOT OK THEN _
  311.          GOTO 20172
  312. 20167 B$(0) = B$(LIST.INDEX)
  313.       IF NOT LIST.NEW THEN _
  314.          GOTO 20168
  315.       GOSUB 20120
  316.       IF FILESYS.PARAMETER > 1 THEN _
  317.          RETURN
  318.       GOTO 20170
  319. 20168 CALL BUFFILE(FILE.NAME$,LIST.INDEX)
  320.       CALL CARRIER
  321.       IF SUBROUTINE.PARAMETER = -1 THEN _
  322.          FILESYS.PARAMETER = 7 : _
  323.          RETURN
  324. 20170 IF LIST.INDEX > 255 THEN _
  325.          LIST.INDEX = 0 : _
  326.          RETURN
  327.       B$(LIST.INDEX) = B$(0)
  328.       GOTO 20175
  329. 20172 IF NOT SEARCHING.ALL THEN _
  330.          A$ = "Directory " + _
  331.               FILE.NAME.HOLD$ + _
  332.               " not found!" : _
  333.          GOSUB 21640 : _
  334.          NO = TRUE : _
  335.          IF FILESYS.PARAMETER > 1 THEN _
  336.             RETURN
  337. 20175 LIST.INDEX = LIST.INDEX + 1
  338.       GOTO 20160
  339. 20176 CALL SVIOLATION
  340.       IF DENY.ACCESS THEN _
  341.          FILESYS.PARAMETER = 4 : _
  342.          RETURN
  343.       GOTO 20172
  344. '
  345. ' *  D - COMMAND FROM FILES MENU (SEARCH FOR FILE TO DOWNLOAD)
  346. '
  347. 20180 IF Q > 1 THEN _
  348.          B = 2 : _
  349.          GOTO 20202
  350. 20200 A$ = "Download what file(s)"
  351.       GOSUB 21660
  352.       IF FILESYS.PARAMETER > 1 THEN _
  353.          RETURN
  354.       B = 1
  355.       IF Q = 0 THEN _
  356.          RETURN
  357. 20202 IF (TIME.LOCK AND 2) AND (NOT TIME.LOCK.EXEMPT) AND NOT HAS.PRIVDOOR THEN _ ' KG052501
  358.          CALL TIMELOCK : _
  359.          IF NOT OK THEN _
  360.             RETURN
  361.       LAST.DOWNLOAD = Q
  362.       FIRST.DOWNLOAD = B
  363.       COMMAND.TRANSFER$ = ""
  364.       IF AUTODOWNLOAD.AVAILABLE THEN _
  365.          COMMAND.TRANSFER$ = "X"
  366.       AUTODOWNLOAD.IN.PROGRESS = AUTODOWNLOAD.AVAILABLE
  367.       IF LAST.DOWNLOAD > FIRST.DOWNLOAD THEN _
  368.          Z$ = B$(LAST.DOWNLOAD) : _
  369.          CALL ALLCAPS(Z$) : _
  370.          IF LEN (Z$) = 1 AND INSTR(DFLTXFER$,Z$) > 0 THEN _
  371.             LAST.DOWNLOAD = LAST.DOWNLOAD - 1 : _
  372.             COMMAND.TRANSFER$ = Z$ : _
  373.             AUTODOWNLOAD.IN.PROGRESS = FALSE : _
  374.             IF MID$(INTERNAL.EQUIV$,INSTR(DFLTXFER$,Z$),1) = "N" THEN _
  375.                COMMAND.TRANSFER$ = ""
  376.       BATCH.BYTES# = 0
  377.       BATCH.BLOCKS# = 0
  378.       CALL KILLWORK (NODE.WORK.FILE$)
  379.       EC = 0
  380.       FOR DWN.INDEX = FIRST.DOWNLOAD TO LAST.DOWNLOAD
  381.          GOSUB 20205
  382.          IF FILESYS.PARAMETER > 1 THEN _
  383.             DWN.INDEX = LAST.DOWNLOAD + 1
  384. 20203 NEXT
  385.       IF FILESYS.PARAMETER > 1 THEN _
  386.          RETURN
  387.       BATCH.TRANSFER = FALSE
  388.       COMMAND.TRANSFER$ = ""
  389.       RETURN
  390. 20205 MARK.TIME = (DWN.INDEX = FIRST.DOWNLOAD OR NOT CONCAT.FILES)
  391.       FILE.NAME$ = B$(DWN.INDEX)
  392.       VIOLATION$ = "Download "
  393.       IF PERSONAL.DOWNLOAD THEN _
  394.          CALL BRKFNAME (FILE.NAME$,DR$,Y$,X$,TRUE) : _
  395.          FILE.NAME.HOLD$ = Y$ + _
  396.                            X$ : _
  397.          GOTO 20235
  398.       FILE.NAME.HOLD$ = FILE.NAME$
  399.       CALL BADFILE (FILE.NAME$,BAD.FILE.NAME.INDEX)
  400.       ON BAD.FILE.NAME.INDEX GOTO 20220,20231,20233
  401. 20220 CALL ROTORSDIR (FILE.NAME$,SUBDIR$(),SUBDIR.COUNT + _
  402.                       ((USER.SECURITY.LEVEL < MIN.SEC.TO.VIEW) OR _
  403.                        NOT CAN.DOWNLOAD.FROM.UP),MARK.TIME)
  404. 20225 IF OK THEN _
  405.          GOTO 20235
  406. 20231 A$ = FILE.NAME.HOLD$ + _
  407.            " not found!"
  408.       CALL UPDTCALR (A$,2)
  409.       AUTO.LOGOFF = FALSE
  410.       IF AUTODOWNLOAD.IN.PROGRESS THEN _
  411.          A$ = A$ + _
  412.               " during AUTODOWNLOAD" : _
  413.          GOSUB 21640 : _
  414.          RETURN
  415.       A$ = A$ + _
  416.            " Correct name"+PRESS.ENTER.EXPERT$
  417.       GOSUB 21660
  418.       IF FILESYS.PARAMETER > 1 THEN _
  419.          RETURN
  420.       IF Q=0 THEN _
  421.          RETURN
  422.       B$(DWN.INDEX) = B$(1)
  423.       GOTO 20205
  424. 20233 CALL SVIOLATION
  425.       IF DENY.ACCESS THEN _
  426.          FILESYS.PARAMETER = 4 : _
  427.          RETURN
  428.       GOTO 20231
  429. 20235 CALL BADNAME (BAD.FILE.NAME.INDEX)
  430.       ON BAD.FILE.NAME.INDEX GOTO  20236,20245
  431. 20236 LINE.25$ = "(D) " + _
  432.                  Z$
  433.       IF AUTODOWNLOAD.IN.PROGRESS THEN _
  434.          MID$(LINE.25$,2,1) = "A"
  435. '
  436. ' *  TEST FOR DOWNLOAD SECURITY
  437. '
  438.       CALL OPENWORK (2,FILESEC.FILE$)
  439.       IF EC = 53 THEN _
  440.          CALL UPDTCALR ("Missing file " + FILESEC.FILE$,2) : _
  441.          GOTO 20247
  442. 20242 IF EOF(2) THEN _
  443.          GOTO 20247
  444.       CALL READPARMS (WORK.ARA$(),3,1)
  445.       IF EC <> 0 THEN _
  446.          EL = 20242 : _
  447.          GOTO 21900
  448. 20243 CALL WILDFILE (WORK.ARA$(1),Z$,OK)
  449.       IF NOT OK THEN _
  450.          GOTO 20242
  451. 20244 IF USER.SECURITY.LEVEL < VAL(WORK.ARA$(2)) THEN _
  452.          GOTO 20245
  453.       FILE.PASSWORD$ = WORK.ARA$(3)
  454.       IF FILE.PASSWORD$ = "" THEN _
  455.          GOTO 20247
  456.       CALL ALLCAPS (FILE.PASSWORD$)
  457.       IF FILE.PASSWORD$ = PASSWORD$ THEN _
  458.          GOTO 20247
  459.       A$ = "Enter PASSWORD to download " + _
  460.            FILE.NAME$
  461.       GOSUB 21660
  462.       IF FILESYS.PARAMETER > 1 THEN _
  463.          RETURN
  464.       IF Q = 0 THEN _
  465.          RETURN
  466.       CALL ALLCAPS (B$(1))
  467.       IF B$(1) = FILE.PASSWORD$ THEN _
  468.          GOTO 20247
  469. 20245 VIOLATION$ = "DownLoad " + _
  470.                    FILE.NAME$
  471. 20246 CALL SVIOLATION
  472.       IF DENY.ACCESS THEN _
  473.          FILESYS.PARAMETER = 4
  474.       RETURN
  475. 20247 DF = 0
  476.       CALL BRKFNAME (FILE.NAME$,DR$,X$,EXTENTION$,FALSE)
  477.       IF AUTODOWNLOAD.IN.PROGRESS THEN _
  478.          A$ = "Transferring -- " + _
  479.               B$(DWN.INDEX) : _
  480.          GOSUB 21640 : _
  481.          IF FILESYS.PARAMETER > 1 THEN _
  482.             RETURN
  483.       IF EXTENTION$ = "" OR RELIABLE.MODE OR _
  484.          COMMAND.TRANSFER$ > "A" OR (USER.TRANSFER.DEFAULT$ > "A" AND _
  485.          INTERNAL.PROTO$ <> "N") THEN _
  486.             GOTO 20248
  487.       IF INSTR(".WRK.FW .ARC.EXE.COM.OBJ.WKS.LBR.ZIP.PAK.ZOO",EXTENTION$) OR _
  488.          MID$(EXTENTION$,2,1) = "Q" OR _
  489.          (REQUIRE.NON.ASCII AND EXTENTION$ = "BAS") THEN _
  490.          CALL QTPUT1 ("Non-ASCII required for " + FILE.NAME.HOLD$) : _
  491.          DF = TRUE
  492. 20248 A$ = ""
  493.       IF BATCH.TRANSFER THEN _
  494.          IF DWN.INDEX < LAST.DOWNLOAD THEN _
  495.             GOTO 20260
  496.       CALL XFERTYPE (2,TRUE)
  497.       IF FF THEN _
  498.          GOTO 20260
  499.       CALL XFERTYPE (1,TRUE)
  500.       IF SUBROUTINE.PARAMETER = -1 THEN _
  501.          RETURN
  502. 20260 TRANSFER.FUNCTION = 1
  503.       GOSUB 21790
  504.       IF FILESYS.PARAMETER > 1 THEN _
  505.          RETURN
  506.       BATCH.TRANSFER = (BATCH.PROTO AND (LAST.DOWNLOAD > FIRST.DOWNLOAD))
  507.       IF BATCH.TRANSFER AND COMMAND.TRANSFER$ = "" THEN _
  508.          COMMAND.TRANSFER$ = FT$
  509.       ON INSTR("AXCYN",INTERNAL.PROTO$) GOTO _
  510.          20340, _              ' ASCII DOWNLOAD
  511.          20290, _              ' XMODEM
  512.          20290, _              ' XMODEM CRC
  513.          20270, _              ' YMODEM
  514.          21700                 ' NONE - CANCEL
  515. '
  516. ' *  EXTERNAL PROTOCOL DOWNLOADS/UPLOADS
  517. '
  518. 20261 IF REQ.8.BIT THEN _
  519.          IF NOT EIGHT.BIT THEN _
  520.             GOSUB 20318 : _
  521.             IF FILESYS.PARAMETER > 1 THEN _
  522.                RETURN _
  523.             ELSE GOSUB 20992 : _
  524.                  IF FILESYS.PARAMETER > 1 THEN _
  525.                     RETURN
  526.       IF TRANSFER.FUNCTION = 1 THEN _
  527.          GOSUB 20750 : _
  528.          CLOSE 2 : _
  529.          IF FILESYS.PARAMETER > 1 OR NOT OK THEN _
  530.             RETURN
  531.       IF BATCH.TRANSFER THEN _
  532.          IF DWN.INDEX < LAST.DOWNLOAD THEN _
  533.             RETURN _
  534.          ELSE BLOCKS.IN.FILE# = BATCH.BLOCKS# : _
  535.               BYTES.IN.FILE# = BATCH.BYTES# : _
  536.               NUM.DNLD.BYTS! = BATCH.BYTES# : _
  537.               GOSUB 20780 : _
  538.               IF FILESYS.PARAMETER > 1 OR NOT OK THEN _
  539.                 RETURN
  540.       IF AUTODOWNLOAD.IN.PROGRESS THEN _
  541.          CALL SENDNAME : _
  542.          IF ABORT THEN _
  543.             DOWNLOAD.COMPLETED = FALSE : _
  544.             GOSUB 21760 : _
  545.             RETURN
  546.       CALL TRANSFER
  547. 20262 IF PRIVATE.DOOR THEN _
  548.          COMMAND.TRANSFER$ = FT$ : _
  549.          CALL XFERTYPE (2,TRUE) : _
  550.          COMMAND.TRANSFER$ = ""
  551.       CALL OPENWORK (2,"XFER-" + NODE.ID$ + ".DEF")
  552.       IF EC <> 0 THEN _
  553.          GOTO 20267
  554.       CALL READPARMS (WORK.ARA$(), FAILURE.PARM, 1)
  555.       IF EC <> 0 THEN _
  556.          GOTO 20267
  557.       CALL KILLWORK ("XFER-" + NODE.ID$ + ".DEF")
  558. 20264 IF PRIVATE.DOOR THEN _
  559.          FILE.NAME$ = WORK.ARA$(1) : _
  560.          CALL BRKFNAME (FILE.NAME$,X$,FILE.NAME.HOLD$,Y$,TRUE) : _
  561.          FILE.NAME.HOLD$ = FILE.NAME.HOLD$ + _
  562.                            Y$ : _
  563.          SIZE.ONLY = TRUE : _
  564.          CALL OPENWORK (2,FILE.NAME$) : _
  565.          GOSUB 20760 : _
  566.          IF FILESYS.PARAMETER > 1 OR NOT OK THEN _
  567.             RETURN
  568.          IF LEFT$(WORK.ARA$(FAILURE.PARM),1) = "L" THEN _
  569.             MID$(WORK.ARA$(FAILURE.PARM),1,1) = FAILURE.STRING$
  570. 20265 IF TRANSFER.FUNCTION = 2 THEN _
  571.          IF INSTR(WORK.ARA$(FAILURE.PARM),FAILURE.STRING$) <> 1 THEN _
  572.             GOTO 20700 _
  573.          ELSE GOTO 20730
  574.       IF TRANSFER.FUNCTION = 1 THEN _
  575.          DOWNLOAD.COMPLETED = (INSTR(WORK.ARA$(FAILURE.PARM),FAILURE.STRING$) <> 1)
  576.       GOSUB 21760
  577.       CALL CARRIER
  578.       IF SUBROUTINE.PARAMETER = -1 THEN _
  579.          FILESYS.PARAMETER = 7
  580.       RETURN
  581. '
  582. ' *  XFER FILE NOT FOUND
  583. '
  584. 20267 EL = 20262
  585.       GOTO 21900
  586.  
  587. '
  588. ' *  YMODEM DOWNLOAD DRIVER
  589. '
  590. 20270 GOTO 20292
  591. '
  592. ' *  XMODEM DOWNLOAD DRIVER
  593. '
  594. 20290 '
  595. 20292 GOSUB 20750
  596.       IF FILESYS.PARAMETER > 1 OR NOT OK THEN _
  597.          RETURN
  598.       A1$ = "SEND"
  599.       GOSUB 20320
  600.       IF FILESYS.PARAMETER > 1 THEN _
  601.          RETURN
  602.       IF LOCAL.USER THEN _
  603.          CALL QTPUT1 ("Protocol not available in local mode") : _
  604.          RETURN
  605.       IF AUTODOWNLOAD.IN.PROGRESS THEN _
  606.          GOSUB 20294 : _
  607.          IF ABORT THEN _
  608.             RETURN
  609.       GOSUB 21300
  610.       IF FILESYS.PARAMETER > 1 THEN _
  611.          RETURN
  612.       A$ = ""
  613.       GOTO 20390
  614. 20294 CALL SENDNAME
  615.       RETURN
  616. 20318 A$ = "Please SWITCH to N,8,1 for binary transfer"
  617.       GOSUB 21630
  618.       IF FILESYS.PARAMETER > 1 THEN _
  619.          RETURN
  620.       CALL DELAYIT (3)
  621.       RETURN
  622. 20320 IF NOT EIGHT.BIT THEN _
  623.          GOSUB 20318 : _
  624.          IF FILESYS.PARAMETER > 1 THEN _
  625.             RETURN
  626. 20325 IF CHECKSUM THEN _
  627.          NEGATIVE.ACKNOWLEDGE$ = CHR$(21) : _
  628.          SOL = 132 _
  629.       ELSE NEGATIVE.ACKNOWLEDGE$ = "C" : _
  630.            SOL = 133
  631. 20330 IF AUTODOWNLOAD.IN.PROGRESS THEN _
  632.          RETURN
  633.       A$ = PROTO.PROMPT$ + _
  634.             " " + A1$ + _
  635.             " of " + _
  636.             FILE.NAME.HOLD$ + _
  637.             " ready.  <Ctrl X> aborts"
  638.       GOSUB 21650
  639.       IF A1$ = "SEND" THEN _
  640.          CALL TALK (8,A$) _
  641.       ELSE CALL TALK (9,A$)
  642.       RETURN
  643. '
  644. ' *  ASCII DOWNLOAD DRIVER
  645. '
  646. 20340 IF DF THEN _
  647.          A$ = "Switch to a non-ascii protocol" : _
  648.          GOSUB 21650 : _
  649.          RETURN
  650.       GOSUB 20750
  651.       IF FILESYS.PARAMETER > 1 OR NOT OK THEN _
  652.          RETURN
  653.       CALL OPENWORK (2,FILE.NAME$)
  654.       IF (DWN.INDEX = FIRST.DOWNLOAD OR NOT CONCAT.FILES) THEN _
  655.          A$ = "^X aborts.  ^S suspends ^Q resumes" : _
  656.          GOSUB 21640 : _
  657.          IF FILESYS.PARAMETER > 1 THEN _
  658.             RETURN _
  659.          ELSE A$ = PROTO.PROMPT$ + " SEND of " + _
  660.               FILE.NAME.HOLD$ + _
  661.               " ready. Press Any Key to start" : _
  662.          TURBO.KEY = 2 : _
  663.          GOSUB 21660 : _
  664.          IF FILESYS.PARAMETER > 1 THEN _
  665.             RETURN
  666. 20380 STOP.INTERRUPTS = FALSE
  667.       TU = 0
  668.       SWAP TU,PAGE.LENGTH
  669.       CALL BUFFILE (FILE.NAME$,X)
  670.       SWAP TU,PAGE.LENGTH
  671.       NON.STOP = (PAGE.LENGTH < 1)
  672.       IF STOP.FILE THEN _
  673.          DOWNLOAD.COMPLETED = FALSE : _
  674.          GOTO 20390
  675. 20381 IF (DWN.INDEX = LAST.DOWNLOAD OR NOT CONCAT.FILES) THEN _
  676.          CALL QTPUT (CHR$(26),0) : _
  677.          IF NOT LOCAL.USER AND SUBROUTINE.PARAMETER = 0 THEN _
  678.             FOR X = 1 TO 5 : _
  679.                CALL PUTCOM (CHR$(7)) : _
  680.                CALL DELAYIT (3) : _
  681.             NEXT
  682. 20385 DOWNLOAD.COMPLETED = TRUE
  683. 20390 GOTO 21760
  684. '
  685. ' *  U - COMMAND FROM FILES MENU (UPLOAD)
  686. '
  687. 20395 GOSUB 21640
  688.       IF FILESYS.PARAMETER > 1 THEN _
  689.          RETURN
  690.       A$ = "Correct name of file to upload" + _
  691.            PRESS.ENTER.EXPERT$
  692.       GOSUB 21660
  693.       IF FILESYS.PARAMETER > 1 THEN _
  694.          RETURN
  695.       IF Q = 0 THEN _
  696.          RETURN
  697.       B$(ANS.INDEX) = B$(1)
  698.       GOTO 20435
  699. 20400 CALL TIMEREMAIN (TIME.REMAINING!)
  700.       Q! = TCA!
  701.       FIRST.UPLOAD = 1
  702.       IF Q > 1 THEN _
  703.          FIRST.UPLOAD = 2 : _
  704.          GOTO 20430
  705.       GOSUB 20420
  706.       GOTO 20430
  707. 20420 A$ = "Upload what file(s)"
  708.       GOSUB 21660
  709.       IF FILESYS.PARAMETER > 1 THEN _
  710.          RETURN
  711.       IF Q = 0 THEN _
  712.          RETURN
  713.       RETURN
  714. '
  715. ' *  SEARCH FOR DUPLICATE FILENAME
  716. '
  717. 20430 LAST.UPLOAD = Q
  718.       Z$ = B$(LAST.UPLOAD)
  719.       IF LEN(Z$) = 1 THEN _
  720.          CALL ALLCAPS (Z$) : _
  721.          IF INSTR(DFLTXFER$,Z$) > 0 THEN _
  722.             LAST.UPLOAD = LAST.UPLOAD - 1 : _
  723.             COMMAND.TRANSFER$ = Z$
  724.       FOR ANS.INDEX = FIRST.UPLOAD TO LAST.UPLOAD
  725.          GOSUB 20435
  726.          IF FILESYS.PARAMETER > 1 THEN _
  727.             ANS.INDEX = LAST.UPLOAD + 1
  728.       NEXT
  729.       COMMAND.TRANSFER$ = ""
  730.       RETURN
  731. 20435 FILE.NAME.HOLD$ = B$(ANS.INDEX)
  732.       CALL ALLCAPS(FILE.NAME.HOLD$)
  733.       FILE.NAME$ = FILE.NAME.HOLD$
  734.       VIOLATION$ = "Upload "
  735.       CALL NOPATH (FILE.NAME$,BAD.FILE.NAME.INDEX)                   ' KG060801
  736.       IF BAD.FILE.NAME.INDEX THEN _                                  ' KG060801
  737.          GOTO 20451                                                  ' KG060801
  738.       CALL BADFILE (FILE.NAME$,BAD.FILE.NAME.INDEX)
  739.       ON BAD.FILE.NAME.INDEX GOTO 20440,20451,20515
  740. 20440 CALL ROTORSDIR (FILE.NAME$,SUBDIR$(),SUBDIR.COUNT,TRUE)
  741. 20450 IF OK THEN _
  742.          GOTO 20452
  743.       CALL BRKFNAME (FILE.NAME$,DR$,X$,EXTENTION$,FALSE)
  744.       IF EXTENTION$ = DEFAULT.EXTENSION$ THEN _
  745.          GOTO 20475
  746.       X$ = X$ + "." + DEFAULT.EXTENSION$
  747.       CALL ROTORSDIR (X$,SUBDIR$(),SUBDIR.COUNT,FALSE)
  748.       IF OK THEN _
  749.          FILE.NAME.HOLD$ = DEFAULT.EXTENSION$ + " ver of " + FILE.NAME.HOLD$ : _
  750.          GOTO 20454
  751.       GOTO 20475
  752. 20451 A$ = "Invalid file name"
  753.       GOTO 20395
  754. 20452 IF USER.SECURITY.LEVEL < OVERWRITE.SECURITY.LEVEL THEN _
  755.          GOTO 20453
  756.       A$ = "Overwrite file (Y,[N])"
  757.       GOSUB 21660
  758.       IF FILESYS.PARAMETER > 1 THEN _
  759.          RETURN
  760.       IF NOT YES THEN _
  761.          GOTO 20453
  762.       Z$ = FILE.NAME$
  763.       CALL KILLWORK (FILE.NAME$)
  764.       IF EC <> 0 THEN _
  765.          EL = 20452 : _
  766.          GOTO 21900
  767.       GOTO 20475
  768. 20453 CLOSE 2
  769.       IF USER.SECURITY.LEVEL >= ADD.DIR.SECURITY THEN _
  770.          GOTO 20455
  771. 20454 CALL QTPUT1 ("Thanks, but we already have " + FILE.NAME.HOLD$)
  772.       CALL UPDTCALR ("Upload duplicate " + FILE.NAME.HOLD$,1)
  773.       RETURN
  774. 20455 A$ = "Add new directory entry (Y,[N])"
  775.       TURBO.KEY = - TURBO.KEY.USER
  776.       GOSUB 21660
  777.       IF FILESYS.PARAMETER > 1 THEN _
  778.          RETURN
  779.       IF NOT YES THEN _
  780.          RETURN
  781.       ADDING.DESC.ONLY = TRUE
  782.       FT$ = "l"
  783.       GOSUB 20702
  784.       RETURN
  785. 20475 Z$ = UPLOAD.DRIVE.FILE$
  786.       CALL FINDFREE
  787.       IF VAL(FREE.SPACE$) < 4096 THEN _
  788.          CALL QTPUT1 ("No room for uploads.  Try tomorrow.") : _
  789.          ANS.INDEX = LAST.UPLOAD + 1 : _
  790.          RETURN
  791.       A$ = "Upload disk has" + _
  792.            FREE.SPACE$
  793.       GOSUB 21640
  794.       IF FILESYS.PARAMETER > 1 THEN _
  795.          RETURN
  796.       LINE.25$ = "(U) " + _
  797.                  FILE.NAME.HOLD$
  798.       SUBROUTINE.PARAMETER = 2
  799.       CALL LINE25
  800.       A$ = ""
  801.       OK = TRUE
  802. 20477 CALL XFERTYPE (2,TRUE)
  803.       IF FF THEN _
  804.          GOTO 20500
  805.       CALL XFERTYPE (1,TRUE)
  806.       IF SUBROUTINE.PARAMETER = -1 THEN _
  807.          RETURN
  808. 20500 TRANSFER.FUNCTION = 2
  809.       AUTODOWNLOAD.IN.PROGRESS = FALSE
  810.       GOSUB 21790
  811.       IF FILESYS.PARAMETER > 1 THEN _
  812.          RETURN
  813.       ON INSTR("AXCYN",INTERNAL.PROTO$) GOTO _
  814.          20560, _         ' ASCII UPLOAD
  815.          20542, _         ' XMODEM
  816.          20542, _         ' XMODEM CRC
  817.          20542, _         ' YMODEM
  818.          20735            ' NONE - CANCEL
  819.       GOTO 20261
  820. 20510 D$ = "<Esc> by SYSOP aborts"
  821.       GOSUB 21710
  822.       RETURN
  823. 20515 CALL SVIOLATION
  824.       IF DENY.ACCESS THEN _
  825.          FILESYS.PARAMETER = 4 : _
  826.          RETURN
  827.       GOTO 20420
  828. '
  829. ' *  XMODEM/YMODEM UPLOAD DRIVER
  830. '
  831. 20542 A1$ = "RECEIVE"
  832.       GOSUB 20320
  833.       IF FILESYS.PARAMETER > 1 THEN _
  834.          RETURN
  835.       OK = TRUE
  836.       GOSUB 20860
  837.       IF FILESYS.PARAMETER > 1 THEN _
  838.          RETURN
  839.       IF OK THEN _
  840.          GOTO 20700
  841.       GOTO 20730
  842. '
  843. ' *  ASCII UPLOAD
  844. '
  845. 20560 LINE.ACK = (DEFAULT.LINE.ACK$ <> "")
  846.       IF LINE.ACK THEN _
  847.          A$ = "Acknowledge each line ([Y],N)" : _
  848.          TURBO.KEY = - TURBO.KEY.USER : _
  849.          GOSUB 21660 : _
  850.          LINE.ACK = NOT NO : _
  851.          IF FILESYS.PARAMETER > 1 THEN _
  852.             RETURN
  853.       CALL QTPUT1 ("Transfer MUST end with a <Ctrl-K>")
  854.       CALL QTPUT1 (PROTO.PROMPT$+" RECEIVE of " + FILE.NAME.HOLD$ + " ready")
  855.       OK = FALSE
  856.       XOFF = FALSE
  857.       CALL OPENOUTW(FILE.NAME$)
  858.       IF EC <> 0 AND EC <> 53 THEN _
  859.          EL = 20560 : _
  860.          GOTO 21900
  861.       GOSUB 20510
  862.       IF FILESYS.PARAMETER > 1 THEN _
  863.          RETURN
  864. 20600 CALL EOFCOMM (CHAR%)
  865.       WHILE CHAR% <> -1
  866.          CALL CARRIER
  867.          IF SUBROUTINE.PARAMETER = -1 THEN _
  868.             FILESYS.PARAMETER = 7 : _
  869.             RETURN
  870.          IF NOT FOSSIL THEN _
  871.             IF LOF(3) < 512 THEN _
  872.                CALL PUTCOM(XOFF$) : _
  873.                XOFF = TRUE
  874. 20610    CALL FLUSHCOM (X$)
  875.          IF SUBROUTINE.PARAMETER = -1 THEN _
  876.             RETURN
  877.          IF INSTR(X$,CHR$(11)) THEN _
  878.             GOTO 20650
  879.          OK = TRUE
  880. 20620    CALL PRINTWRK (X$)
  881.          IF LINE.ACK THEN _
  882.             IF INSTR(X$,CHR$(10)) > 0 THEN _
  883.                CALL PUTCOM (DEFAULT.LINE.ACK$)
  884.          IF EC <> 0 THEN _
  885.             EL = 20620 : _
  886.             GOTO 21900
  887.          D$ = X$
  888.          NUM.RETURNS = 0
  889.          GOSUB 21720
  890.          IF FILESYS.PARAMETER > 1 THEN _
  891.             RETURN
  892. 20621    CALL FINDFUNC
  893.          IF SUBROUTINE.PARAMETER < 0 THEN _
  894.             FILESYS.PARAMETER = 2 : _
  895.             RETURN
  896.          IF KEY.PRESSED$ = ESCAPE$ THEN _
  897.             GOTO 20745
  898.          IF NOT OK THEN _
  899.             GOTO 20670
  900.       CALL EOFCOMM (CHAR%)
  901. 20630 WEND
  902.       CALL CARRIER
  903.       IF SUBROUTINE.PARAMETER = -1 THEN _
  904.          FILESYS.PARAMETER = 7 : _
  905.          RETURN
  906.       IF XOFF THEN _
  907.          XOFF = FALSE : _
  908.          CALL PUTCOM (XON$) : _
  909.          IF EC <> 0 THEN _
  910.             EL = 20630 : _
  911.             GOTO 21900
  912.       GOTO 20600
  913. 20650 X = INSTR(X$,CHR$(11))
  914.       IF X = 1 THEN _
  915.          IF NOT OK THEN _
  916.             GOTO 20730 _
  917.          ELSE GOTO 20700
  918.       CALL PRNTWRKA (LEFT$(X$,X-1))
  919.       IF EC <> 0 THEN _
  920.          EL = 20650 : _
  921.          GOTO 21900
  922.       GOTO 20700
  923. 20670 A$ = XOFF$ + _
  924.            "System error! Upload aborted <Ctrl-K> continues"
  925. 20675 GOSUB 21650
  926.       IF FILESYS.PARAMETER > 1 THEN _
  927.          RETURN
  928.       CALL DELAYIT (3)
  929.       CALL PUTCOM(XON$)
  930. 20680 CALL EOFCOMM (CHAR%)
  931.       WHILE CHAR% <> -1
  932.          CALL FLUSHCOM(X$)
  933.          IF INSTR(X$,CHR$(11)) THEN _
  934.             GOTO 20730
  935. 20685    CALL CARRIER
  936.          IF SUBROUTINE.PARAMETER = -1 THEN _
  937.             FILESYS.PARAMETER = 7 : _
  938.             RETURN
  939.       CALL EOFCOMM (CHAR%)
  940.       WEND
  941.       GOTO 20680
  942. '
  943. ' *  UPDATE UPLOAD DIRECTORY
  944. '
  945. 20700 GOSUB 21780
  946.       IF FILESYS.PARAMETER > 1 THEN _
  947.          RETURN
  948. 20702 CALL UPDTUPLOAD (CATEGORY.NAME$(),CATEGORY.CODE$(), LINES.IN.MESSAGE)
  949.       PRIVATE.DOOR = FALSE
  950.       IF NOT GET.EXT.DESC THEN _
  951.          GOTO 20710
  952.       MSG.HEADER$ = "Extended Description for " + FILE.NAME.HOLD$    ' KG072003
  953.       SYSOP.COMMENT = TRUE
  954.       MAX.MESSAGE.LINES = MAX.EXTENDED.LINES
  955.       LL = RIGHT.MARGIN
  956.       RIGHT.MARGIN = 30 + MAX.DESC.LEN
  957.       FILESYS.PARAMETER = 5
  958.       RETURN
  959. 20705 MAX.MESSAGE.LINES = MAX.MESSAGE.LINES.DEF
  960.       RIGHT.MARGIN = LL
  961.       GOTO 20702
  962. 20710 ADDING.DESC.ONLY = FALSE
  963.       IF BYTES.IN.FILE# > 0.0 THEN _
  964.          GOTO 21770
  965. 20730 GOSUB 21780
  966.       CALL QTPUT1 ("Upload aborted")
  967.       PRIVATE.DOOR = FALSE
  968. 20735 CALL KILLWORK (FILE.NAME$)
  969.       IF EC <>0 THEN _
  970.          EL = 20736 : _
  971.          GOTO 21900
  972.       RETURN
  973. '
  974. ' *  SYSOP ABORTED UPLOAD
  975. '
  976. 20745 A$ = XOFF$ + _
  977.            "SYSOP aborted upload. Stop tranfer. <Ctrl-K> continues"
  978.       GOTO 20675
  979. '
  980. ' *  CALCULATE DOWNLOAD TIME ESTIMATE
  981. '
  982. 20750 START.OF.HEADER$ = CHR$(1 - (INTERNAL.PROTO$ = "Y"))
  983.       CALL OPENRSEQ (FILE.NAME$,MAX.BLOCK,DF,FLEN)
  984. 20760 IF EC <> 0 THEN _
  985.          CALL QTPUT1 ("Unable to access "+FILE.NAME.HOLD$) : _
  986.          CALL UPDTCALR ("Unable to access "+FILE.NAME$,2) : _
  987.          OK = FALSE : _
  988.          EC = 0 : _
  989.          BYTES.IN.FILE# = 0 : _
  990.          RETURN
  991.       BYTES.IN.FILE# = LOF(2)
  992.       NUM.DNLD.BYTS! = LOF(2)
  993.       OK = TRUE
  994.       IF SIZE.ONLY THEN _
  995.          SIZE.ONLY = FALSE : _
  996.          RETURN
  997.       BLOCKS.IN.FILE# = MAX.BLOCK
  998.       IF BATCH.TRANSFER THEN _
  999.          BATCH.BYTES# = BATCH.BYTES# + BYTES.IN.FILE# : _
  1000.          BATCH.BLOCKS# = BATCH.BLOCKS# + BLOCKS.IN.FILE# : _
  1001.          CALL OPENWRKA (NODE.WORK.FILE$) : _
  1002.          CALL PRNTWRKA (FILE.NAME$) : _
  1003.          RETURN
  1004. 20780 A$ = "File Size    :"
  1005.       OK = TRUE
  1006.       IF BLOCK.SIZE > 0 THEN _
  1007.          A$ = A$ + _
  1008.               STR$(FIX(BLOCKS.IN.FILE#)) + _
  1009.               " blocks "
  1010. 20785 BLOCKS.IN.FILE# = BLOCKS.IN.FILE# / _
  1011.                         VAL(MID$("0000030004501200240048009601920", -4 * BPS, 4))
  1012.       BLOCKS.IN.FILE# = BLOCKS.IN.FILE# * FLEN / SPEED.FACTOR!
  1013.       IF (DWN.INDEX > 1 AND CONCAT.FILES) THEN _
  1014.          RETURN
  1015.       A$ = A$ + _
  1016.            STR$(BYTES.IN.FILE#) + _
  1017.            " bytes"
  1018.       GOSUB 21650
  1019.       IF FILESYS.PARAMETER > 1 THEN _
  1020.          RETURN
  1021.       IF BYTES.IN.FILE# < 1 THEN _
  1022.          RETURN
  1023. 20790 SUBROUTINE.PARAMETER = 2
  1024.       CALL LINE25
  1025.       A$ = "Transfer Time:" + _
  1026.          STR$(INT(BLOCKS.IN.FILE# / 60)) + _
  1027.          " min," + _
  1028.          STR$(INT(BLOCKS.IN.FILE# - (INT(BLOCKS.IN.FILE# / 60) * 60))) + _
  1029.          " sec (approx)"
  1030.       GOSUB 21650
  1031.       IF FILESYS.PARAMETER > 1 THEN _
  1032.          RETURN
  1033. 20791 IF PERSONAL.DOWNLOAD THEN _
  1034.          RETURN
  1035.       CALL CHKTREMAIN (TIME.REMAINING!)
  1036.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1037.          FILESYS.PARAMETER = 6 : _
  1038.          RETURN
  1039.       OK = TRUE
  1040.       IF (INT(BLOCKS.IN.FILE# / 60) + 1) > INT(TIME.REMAINING!) THEN _
  1041.          A$ = "Not enough time left!" : _
  1042.          CALL UPDTCALR (FILE.NAME$ + " " + A$,2) : _
  1043.          CALL QTPUT1 (A$): _
  1044.          A$ = "" : _
  1045.          OK = FALSE : _
  1046.          RETURN
  1047.       CALL CHECKRATIO (TRUE)
  1048.       RETURN
  1049. 20810 CALL SETABORT (DELAY!,6)
  1050. 20840 CALL EOFCOMM (CHAR%)
  1051.       IF CHAR% = -1 THEN _
  1052.          GOTO 20850
  1053.       CALL FLUSHCOM(Y$)
  1054.       RETURN
  1055. 20850 CALL CHECKTIM (DELAY!)
  1056.       ON SUBROUTINE.PARAMETER GOTO 20840,20851
  1057. 20851 Y$ = ""
  1058.       CALL CHKCARRIER                                                ' KG061203
  1059.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1060.          FILESYS.PARAMETER = 7 : _
  1061.          RETURN
  1062.       RETURN
  1063. '
  1064. ' *  XMODEM/YMODEM UPLOAD
  1065. '
  1066. 20860 GOSUB 20992
  1067.       IF FILESYS.PARAMETER > 1 THEN _
  1068.          RETURN
  1069.       IF NOT EIGHT.BIT THEN _
  1070.          GOSUB 21280 : _
  1071.          IF FILESYS.PARAMETER > 1 THEN _
  1072.             RETURN
  1073. 20900 X$ = ""
  1074.       SEC = 1
  1075.       'CALL OPENOUTW (FILE.NAME$)
  1076.       IF FLEN > WRITE.BUF.DEF THEN _
  1077.          WRITE.BUF = FLEN _
  1078.       ELSE WRITE.BUF = WRITE.BUF.DEF
  1079.       CALL OPENRSEQ (FILE.NAME$,Y,DF,WRITE.BUF)
  1080.       IF EC <> 0 AND EC <> 53 THEN _
  1081.          EL = 20900 : _
  1082.          GOTO 21900
  1083.       FIELD #2, WRITE.BUF AS UPLOAD.RECORD$
  1084.       RECS.WRIT = 0
  1085.       NUM.IN.BUFF = 0
  1086.       CALL SETABORT (TRANSFER.ABORT!,WAIT.BEFORE.DISCONNECT)
  1087.       YY$ = " " + _
  1088.             CHR$(1) + _
  1089.             CHR$(2) + _
  1090.             END.TRANSMISSION$ + _
  1091.             CANCEL$
  1092. 20903 CALL PUTCOM (NEGATIVE.ACKNOWLEDGE$)
  1093. 20920 X = 1
  1094. 20922 CALL CHKCARRIER                                                ' KG061203
  1095.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1096.          FILESYS.PARAMETER = 7 : _
  1097.          RETURN
  1098.       CALL FINDFUNC
  1099.       IF KEY.PRESSED$ = ESCAPE$ THEN _
  1100.          GOSUB 20510 :_
  1101.          IF FILESYS.PARAMETER > 1 THEN _
  1102.             RETURN _
  1103.          ELSE GOTO 21240
  1104.       GOSUB 20810
  1105.       IF FILESYS.PARAMETER > 1 THEN _
  1106.          RETURN
  1107. 20930 J = INSTR(YY$,LEFT$(Y$,1))
  1108.       ON J GOTO 20960,20999,20999,21220,21230
  1109. 20960 IF Y$ <> "" THEN _
  1110.          GOSUB 21280 : _
  1111.          IF FILESYS.PARAMETER > 1 THEN _
  1112.             RETURN _
  1113.          ELSE CALL CHECKTIM (TRANSFER.ABORT!) : _
  1114.               ON SUBROUTINE.PARAMETER GOTO 20920,21230
  1115. 20970 X = X + 1
  1116.       CALL DELAYIT (1)
  1117.       CALL PUTCOM (NEGATIVE.ACKNOWLEDGE$)
  1118.       IF X < 6 THEN _
  1119.          GOTO 20922
  1120.       D$ = "Upload Timeout"
  1121.       GOSUB 21710
  1122.       IF FILESYS.PARAMETER > 1 THEN _
  1123.          RETURN
  1124.       CALL CHECKTIM (TRANSFER.ABORT!)
  1125.       ON SUBROUTINE.PARAMETER GOTO 20990,21230
  1126. 20990 GOTO 20920
  1127. '
  1128. ' *  CHANGE TO 8 BIT FOR XMODEM
  1129. '
  1130. 20992 GOSUB 20510
  1131.       IF FILESYS.PARAMETER > 1 THEN _
  1132.          FILESYS.PARAMETER = 2 : _
  1133.          RETURN
  1134.       IF NOT EIGHT.BIT THEN _
  1135.          PREV.LINE.CONTROL = INP (LINE.CONTROL.REGISTER) : _
  1136.          CALL DELAYIT (3) : _
  1137.          SWITCHED.TO.EIGHT = TRUE : _
  1138.          OUT LINE.CONTROL.REGISTER,3
  1139. 20996 SO = 0
  1140.       RETURN
  1141. '
  1142. ' *  EXPECTED BLOCK LENGTH. 132 FOR CHECKSUM, 133 FOR CRC, 1029 FOR YMODEM
  1143. '
  1144. 20999 SOL = 896 * J - 1659 + CHECKSUM
  1145.       DATA.SOL = 128 - (SOL > 1024)*896
  1146.       GOTO 21020
  1147. '
  1148. ' *  XMODEM/YMODEM UPLOAD
  1149. '
  1150. 21000 GOSUB 20810
  1151.       IF FILESYS.PARAMETER > 1 THEN _
  1152.          RETURN
  1153.       IF Y$ = "" THEN _
  1154.          D$ = "Upload Timeout" : _
  1155.          GOSUB 21710 : _
  1156.          IF FILESYS.PARAMETER > 1 THEN _
  1157.             RETURN _
  1158.          ELSE GOTO 21040
  1159. 21020 X$ = X$ + _
  1160.            Y$
  1161.       IF LEN(X$) < SOL THEN _
  1162.          GOTO 21000
  1163. 21040 IF LEN(X$) = SOL THEN _
  1164.          GOTO 21090
  1165. 21050 IF LEN(X$) > SOL THEN _
  1166.          GOTO 21180
  1167. 21060 IF X$ = END.TRANSMISSION$ THEN _
  1168.          GOTO 21220
  1169. 21070 IF X$ = CANCEL$ THEN _
  1170.          GOTO 21230
  1171. 21080 GOTO 21170
  1172. 21090 JX = ASC(MID$(X$,2,1))
  1173.       IF SEC = JX THEN _
  1174.          GOTO 21100
  1175.       IF SEC > JX THEN _
  1176.          CALL PUTCOM (RIGHT$(ACKC$,1 - (JX = 0))) : _
  1177.          GOTO 21150
  1178.       GOTO 21200
  1179. 21100 IF (SEC XOR 255) <> ASC(MID$(X$,3,1)) THEN _
  1180.          GOTO 21210
  1181. 21110 IF CHECKSUM THEN _
  1182.          WK$ = MID$(X$,4,128) : _
  1183.          GOSUB 21750 : _
  1184.          IF FILESYS.PARAMETER > 1 THEN _
  1185.             RETURN _
  1186.          ELSE IF XMODEM.CHECKSUM <> ASC(MID$(X$,132,1)) THEN _
  1187.             GOTO 21190 _
  1188.          ELSE GOTO 21120
  1189.       WK$ = MID$(X$,4)
  1190.       GOSUB 21750
  1191.       IF FILESYS.PARAMETER > 1 THEN _
  1192.          RETURN
  1193. 21113 IF CRC.VALUE <> 0 THEN _
  1194.          GOTO 21191
  1195. 21120 SO = SO + 1
  1196.       CALL PUTCOM (ACKNOWLEDGE$)
  1197. 21131 IF NUM.IN.BUFF >= WRITE.BUF THEN _
  1198.          NUM.IN.BUFF = 0 : _
  1199.          CALL PUTWORK (UPLOAD.RECORD$,RECS.WRIT,WRITE.BUF) : _
  1200.          IF EC <> 0 THEN _
  1201.             EL = 21131 : _
  1202.             GOTO 21900
  1203.       MID$(UPLOAD.RECORD$,NUM.IN.BUFF+1,DATA.SOL) = WK$
  1204.       NUM.IN.BUFF = NUM.IN.BUFF + DATA.SOL
  1205. 21145 SEC = 255 AND (SEC + 1)
  1206.       CALL QLPRNT ("OK Rec Blk #",SO)
  1207. 21150 X$ = ""
  1208.       XMODEM.CHECKSUM = 0
  1209.       CALL SETABORT(TRANSFER.ABORT!,45)
  1210.       GOTO 20920
  1211. 21170 A$ = "Short Blk #"
  1212.       GOTO 21212
  1213. 21180 A$ = "Long Blk #"
  1214.       GOTO 21212
  1215. 21190 A$ = "Chksum Error #"
  1216.       GOTO 21212
  1217. 21191 A$ = "CRC Error"
  1218.       GOTO 21212
  1219. 21200 A$ = "Blk # Error in #"
  1220.       JX = ASC(MID$(X$,2,1))
  1221.       IF SEC < JX THEN _
  1222.          GOTO 21212
  1223.       CALL PUTCOM (ACKNOWLEDGE$) ' RIGHT$(ACKC$,1 - (JX = 0)))
  1224.       GOTO 21150
  1225. 21210 A$ = "Complement Error in #"
  1226. 21212 GOSUB 21280
  1227.       IF FILESYS.PARAMETER > 1 THEN _
  1228.          RETURN
  1229.       CALL PUTCOM (NEGATIVE.ACKNOWLEDGE$)
  1230.       CALL LPRNT(LINE.FEED$ + A$ + STR$(SO + 1),0)
  1231.       GOTO 21150
  1232. 21220 IF NUM.IN.BUFF < 1 THEN _
  1233.          GOTO 21225
  1234.       WK$ = LEFT$(UPLOAD.RECORD$,NUM.IN.BUFF)
  1235.       CALL OPENRSEQ (FILE.NAME$,MAX.BLOCK,DF,128)
  1236.       FIELD #2, 128 AS UPLOAD.RECORD$
  1237.       MAX.BLOCK = CDBL(RECS.WRIT) * WRITE.BUF / 128
  1238.       FOR I = 1 TO NUM.IN.BUFF/128
  1239.          CALL PUTWORK (MID$(WK$,128*I-127,128),MAX.BLOCK,128)
  1240.          IF EC > 0 THEN _
  1241.             EL = 21220 : _
  1242.             GOTO 21900
  1243.       NEXT
  1244.       CLOSE 2
  1245. 21225 CALL PUTCOM (ACKNOWLEDGE$)
  1246.       GOTO 21250
  1247. 21230 D$ = LINE.FEED$ + _
  1248.            "Transfer Aborted"
  1249.       GOSUB 21710
  1250.       IF FILESYS.PARAMETER > 1 THEN _
  1251.          RETURN
  1252. 21240 CALL EOFCOMM (CHAR%)
  1253.       IF CHAR% <> -1 THEN _
  1254.          GOSUB 21280 : _
  1255.          IF FILESYS.PARAMETER > 1 THEN _
  1256.             RETURN _
  1257.          ELSE CALL DELAYIT (1) : _
  1258.          GOTO 21240
  1259.       CALL PUTCOM (CANCEL$ + CANCEL$)
  1260.       CALL DELAYIT (1)
  1261.       CALL EOFCOMM (CHAR%)
  1262.       IF CHAR% <> -1 THEN _
  1263.          GOTO 21240
  1264.       OK = FALSE
  1265. 21250 EIGHT.BIT = TRUE
  1266.       RETURN
  1267. '
  1268. ' *  CLEAR GARBAGE OUT OF COMMUNICATIONS BUFFER
  1269. '
  1270. 21280 CALL CHKCARRIER                                                ' KG061203
  1271.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1272.          FILESYS.PARAMETER = 7 : _
  1273.          RETURN
  1274.       CALL EOFCOMM (CHAR%)
  1275.       IF CHAR% = -1 THEN _
  1276.          RETURN
  1277. 21281 CALL FLUSHCOM(DF$)
  1278.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1279.          RETURN
  1280.       GOTO 21280
  1281. '
  1282. ' *  XMODEM/YMODEM DOWNLOAD
  1283. '
  1284. 21300 GOSUB 20992
  1285.       IF FILESYS.PARAMETER > 1 THEN _
  1286.          RETURN
  1287.       SEC = 0
  1288.       GOSUB 21280
  1289.       IF FILESYS.PARAMETER > 1 THEN _
  1290.          RETURN
  1291.       NEGATIVE.ACKNOWLEDGE$ = CHR$(21)
  1292.       CALL SETABORT (TRANSFER.ABORT!,WAIT.BEFORE.DISCONNECT)
  1293. 21303 FIELD 2,FLEN AS DOWNLOAD.RECORD$
  1294. '
  1295. ' *  ROUTINE TO START AN "XMODEM" OR "YMODEM" DOWNLOAD.  CHECK'S INITIAL
  1296. ' *  "HANDSHAKE" TO SEE IF CHARACTER IS SENT IS A:
  1297. ' *           "X" = XMODEM WITH CHECKSUM AND 128 CHARACTER RECORDS
  1298. ' *           "C" = XMODEM WITH CRC CHECK AND 128 CHARACTER RECORDS
  1299. ' *           "Y" = YMODEM WITH CRC CHECK AND 1024 CHARACTER RECORDS
  1300. '
  1301. 21350 CALL EOFCOMM (CHAR%)
  1302.       WHILE CHAR% <> -1
  1303. 21360    CALL GETCOM(Y$)
  1304.          IF Y$ = CANCEL$ THEN _
  1305.             GOTO 21560
  1306. 21380    CHECKSUM = (Y$ = NEGATIVE.ACKNOWLEDGE$)
  1307.          IF CHECKSUM THEN _
  1308.             FF = INSTR(INTERNAL.EQUIV$,"X") : _
  1309.             IF FF > 0 THEN _
  1310.                FT$ = MID$(DFLTXFER$,FF,1) : _
  1311.                GOTO 21480 _
  1312.             ELSE FT$ = "X" : _
  1313.                  GOTO 21480 _
  1314.          ELSE IF Y$ = "C" THEN _
  1315.                  GOTO 21480
  1316.          CALL EOFCOMM (CHAR%)
  1317. 21390 WEND
  1318.       GOSUB 21460
  1319.       IF FILESYS.PARAMETER > 1 THEN _
  1320.          RETURN
  1321.       IF KEY.PRESSED$ = ESCAPE$ THEN _
  1322.          RETURN
  1323.       CALL CHECKTIM (TRANSFER.ABORT!)
  1324.       ON SUBROUTINE.PARAMETER GOTO 21350,21455
  1325. 21410 CALL SETABORT (TRANSFER.ABORT!, WAIT.BEFORE.DISCONNECT)
  1326. '
  1327. ' *  ROUTINE TO WAIT FOR AN ACKNOWLEDGEMENT ON AN "XMODEM" OR "YMODEM"
  1328. ' *  DOWNLOAD
  1329. '
  1330. 21415 CALL EOFCOMM (CHAR%)
  1331.       IF CHAR% <> -1 THEN _
  1332.          GOTO 21420
  1333.       GOSUB 21460
  1334.       IF FILESYS.PARAMETER > 1 THEN _
  1335.          RETURN
  1336.       IF KEY.PRESSED$ = ESCAPE$ THEN _
  1337.          RETURN
  1338.       CALL CHECKTIM (TRANSFER.ABORT!)
  1339.       ON SUBROUTINE.PARAMETER GOTO 21415,21455
  1340. 21420 CALL GETCOM(Y$)
  1341.       IF Y$ = ACKNOWLEDGE$ THEN _
  1342.          GOTO 21470
  1343. 21440 IF Y$ <> NEGATIVE.ACKNOWLEDGE$ THEN _
  1344.          GOTO 21450
  1345. 21443 D$ = LINE.FEED$ + _
  1346.          "Error -> retrans #" + _
  1347.          STR$(SO)
  1348.       GOSUB 21710
  1349.       IF FILESYS.PARAMETER > 1 THEN _
  1350.          RETURN
  1351. 21445 SO = SO - 1
  1352.       GOTO 21490
  1353. 21450 IF Y$ = CANCEL$ THEN _
  1354.          IF HAVE.A.CANCEL THEN _
  1355.             GOTO 21560 _
  1356.          ELSE HAVE.A.CANCEL = TRUE
  1357.       CALL CHECKTIM (TRANSFER.ABORT!)
  1358.       ON SUBROUTINE.PARAMETER GOTO 21415,21455
  1359. 21455 D$ = "Download timeout"
  1360.       GOSUB 21710
  1361.       IF FILESYS.PARAMETER > 1 THEN _
  1362.          RETURN
  1363.       GOTO 21560
  1364. 21460 CALL CHKCARRIER                                                ' KG061203
  1365.       CALL FINDFUNC
  1366.       IF SUBROUTINE.PARAMETER < 0 THEN _
  1367.          FILESYS.PARAMETER = 7 : _
  1368.          RETURN
  1369.       IF KEY.PRESSED$ = ESCAPE$ THEN _
  1370.          GOTO 21540
  1371.       RETURN
  1372. '
  1373. ' *  DISPLAY BLOCK SENT OK AND THEN READ IN NEXT RECORD FROM DISK TO DOWNLOAD
  1374. '
  1375. 21470 CALL QLPRNT ("OK Sent Blk #",SO)
  1376. 21480 IF LOC(2) => MAX.BLOCK THEN _
  1377.          GOTO 21530
  1378.       CALL GETWORK (FLEN)
  1379.       IF EC <> 0 THEN _
  1380.          EL = 21480 : _
  1381.          GOTO 21900
  1382.       SEC = 255 AND (SEC + 1)
  1383.       GOTO 21490
  1384. '
  1385. ' *  ROUTINE TO WRITE OUT AN "XMODEM" OR "YMODEM" RECORD TO THE COMM. PORT
  1386. '
  1387. 21490 SO = SO + 1
  1388.       CALL PUTCOM (START.OF.HEADER$ + CHR$(SEC) + CHR$(SEC XOR 255))
  1389.       CALL PUTCOM (DOWNLOAD.RECORD$)
  1390.       HAVE.A.CANCEL = FALSE
  1391. 21503 WK$ = DOWNLOAD.RECORD$
  1392. 21504 GOSUB 21750
  1393.       IF FILESYS.PARAMETER > 1 THEN _
  1394.          RETURN
  1395. 21510 IF CHECKSUM THEN _
  1396.          CALL PUTCOM(CHR$(XMODEM.CHECKSUM)) _
  1397.       ELSE CALL PUTCOM(CHR$(CRC.HIGH) + CHR$(CRC.LOW))
  1398.       GOSUB 21280
  1399.       IF FILESYS.PARAMETER > 1 THEN _
  1400.          RETURN
  1401.       GOTO 21410
  1402. '
  1403. ' *  END-OF-FILE FOR XMODEM DOWNLOADS -- SEND THE "EOT" CHARACTER AND WAIT UP
  1404. ' *  TO 2 SECONDS FOR A POSITIVE RESPONSE (I.E. AN "ACK").  IF NONE IS
  1405. ' *  RE-TRY UP TO 10 TIMES.  IF NO POSITIVE RESPONSE IS RECEIVED AFTER TEN
  1406. ' *  ATTEMPTS, ASSUME THE DOWNLOAD WAS UNSUCCESSFULL.
  1407. '
  1408. 21530 CALL PUTCOM (END.TRANSMISSION$)
  1409.       X = 1
  1410. 21531 GOSUB 20810
  1411.       IF FILESYS.PARAMETER > 1 THEN _
  1412.          RETURN
  1413.       IF INSTR(Y$,ACKNOWLEDGE$) THEN _
  1414.          GOTO 21550
  1415.       CALL FINDFUNC
  1416.       IF SUBROUTINE.PARAMETER < 0 THEN _
  1417.          FILESYS.PARAMETER = 2 : _
  1418.          RETURN
  1419.       IF KEY.PRESSED$ = ESCAPE$ THEN _
  1420.          GOSUB 21540 : _
  1421.          GOTO 21545
  1422.       IF X < 10 THEN _
  1423.          X = X + 1 : _
  1424.          GOTO 21531
  1425.       DOWNLOAD.COMPLETED = FALSE
  1426.       GOTO 21230
  1427. 21540 GOSUB 20510
  1428.       IF FILESYS.PARAMETER > 1 THEN _
  1429.          RETURN
  1430.       RETURN
  1431. 21545 Y$ = CANCEL$
  1432.       CALL PUTCOM (CANCEL$ + CANCEL$ + CANCEL$)
  1433.       DOWNLOAD.COMPLETED = FALSE
  1434.       GOTO 21250
  1435. 21550 DOWNLOAD.COMPLETED = TRUE
  1436.       GOTO 21250
  1437. 21560 DOWNLOAD.COMPLETED = FALSE
  1438.       D$ = LINE.FEED$ + _
  1439.            "Caller aborted trans"
  1440.       GOSUB 21710
  1441.       IF FILESYS.PARAMETER > 1 THEN _
  1442.          RETURN
  1443.       GOTO 21545
  1444. '
  1445. ' STANDARD ENTRY FOR RBBS-PC'S COMMON TERMINAL OUTPUT ROUTINE
  1446. '
  1447. ' Modeled on lines 12975 to 12983 in RBBS-PC.BAS
  1448. 21630 SUBROUTINE.PARAMETER = 1
  1449.       GOTO 21655
  1450. 21640 SUBROUTINE.PARAMETER = 3
  1451.       GOTO 21655
  1452. 21650 SUBROUTINE.PARAMETER = 5
  1453. 21655 CALL TPUT
  1454.       IF SUBROUTINE.PARAMETER < 0 THEN _
  1455.          FILESYS.PARAMETER = 2 : _
  1456.          RETURN
  1457.       IF SUBROUTINE.PARAMETER = 8 THEN _
  1458.          GOSUB 21660
  1459.       RETURN
  1460. '
  1461. ' STANDARD ENTRY FOR RBBS-PC'S COMMON TERMINAL INPUT ROUTINE
  1462. '
  1463. ' Modeled on lines 12995 to 12997 in RBBS-PC.BAS
  1464. 21660 SUBROUTINE.PARAMETER = 1
  1465.       CALL TGET
  1466.       IF SUBROUTINE.PARAMETER < 0 THEN _
  1467.          FILESYS.PARAMETER = 2
  1468.       RETURN
  1469. 21700 EC = 0
  1470.       RETURN
  1471. '
  1472. ' **** COMMON LOCAL DISPLAY PRINT ***
  1473. '
  1474. '  (formerly lines 1315 to 1320 in RBBS-PC.BAS CPC16-1A
  1475. 21710 NUM.RETURNS = 1
  1476. 21720 CALL LPRNT (D$,NUM.RETURNS)
  1477.       RETURN
  1478. '
  1479. ' *  XMODEM / CRC INTERFACE
  1480. '
  1481. '  (formerly line 46000 in RBBS-PC.BAS CPC16-1A
  1482. 21750 XMODEM.CHECKSUM = 0
  1483.       CRC.VALUE = 0
  1484.       CALL XMODEM(WK$,XMODEM.CHECKSUM,CRC.VALUE,CRC.HIGH,CRC.LOW)
  1485.       RETURN
  1486. '
  1487. ' * UPDATE DOWNLOAD STATISTICS
  1488. '
  1489. '  (formerly lines 50600 to 50614 in RBBS-PC.BAS CPC16-1A
  1490. 21760 GOSUB 21780
  1491.       IF FILESYS.PARAMETER > 1 THEN _
  1492.          RETURN
  1493.       IF BATCH.TRANSFER THEN _
  1494.          CALL LINESNFIL (NODE.WORK.FILE$,DOWN.FILES) _
  1495.       ELSE DOWN.FILES = 1
  1496.       IF NOT DOWNLOAD.COMPLETED THEN _
  1497.          AUTO.LOGOFF = FALSE : _
  1498.          DF$ = " Aborted" _
  1499.       ELSE CALL LOGDOWN (PERSONAL.DOWNLOAD,DWN.INDEX) : _
  1500.            DOWNLOADS = DOWNLOADS + DOWN.FILES : _
  1501.            GLOBAL.DL.TODAY! = GLOBAL.DL.TODAY! + DOWN.FILES : _
  1502.            GLOBAL.DOWNLOADS = GLOBAL.DOWNLOADS + DOWN.FILES : _
  1503.            DLBYTES! = DLBYTES! + NUM.DNLD.BYTS! : _
  1504.            GLOBAL.DLBYTES! = GLOBAL.DLBYTES! + NUM.DNLD.BYTS! : _
  1505.            DL.TODAY! = DL.TODAY! + DOWN.FILES : _
  1506.            BYTES.TODAY! = BYTES.TODAY! + NUM.DNLD.BYTS! : _
  1507.            GLOBAL.BYTES.TODAY! = GLOBAL.BYTES.TODAY! + NUM.DNLD.BYTS! : _ KG102004
  1508.            NUM.DNLD.BYTS! = 0 : _
  1509.            CALL MUZAK (6) : _
  1510.            DF$ = " Downloaded" : _
  1511.            IF (DWN.INDEX = LAST.DOWNLOAD OR NOT CONCAT.FILES) THEN _
  1512.               CALL SKIPLINE (1) : _
  1513.               CALL QTPUT1 ("Download successful")
  1514.       IF AUTODOWNLOAD.IN.PROGRESS THEN _
  1515.          DF$ = " AUTO" + _
  1516.               MID$(N$,2)
  1517.       IF INSTR(N$,"Aborted") THEN _
  1518.          AUTODOWNLOAD.IN.PROGRESS = 0
  1519.       A$ = ""
  1520. 21770 CALL AMORPM                                                    ' KG061203
  1521.       IF NOT BATCH.TRANSFER THEN _
  1522.          GOTO 21773
  1523.       CALL OPENWORK (2,NODE.WORK.FILE$)
  1524.       IF EC > 0 THEN _
  1525.          RETURN
  1526.       Q = 0
  1527.       WHILE NOT EOF(2)
  1528.          CALL READANY
  1529.          Q = Q + 1
  1530.          B$(Q) = A$
  1531.       WEND
  1532. 21772 IF Q < 1 THEN _
  1533.          BATCH.TRANSFER = FALSE : _
  1534.          RETURN
  1535.       CALL OPENWORK (2,B$(Q))
  1536.       IF EC > 0 THEN _
  1537.          EC = 0 : _
  1538.          Q = Q - 1 : _
  1539.          GOTO 21772
  1540.       BYTES.IN.FILE# = LOF(2)
  1541.       FILE.NAME$ = B$(Q)
  1542. 21773 CALL BRKFNAME (FILE.NAME$,DR$,X$,EXTENTION$,TRUE)
  1543.       Z$ = X$ + _
  1544.            EXTENTION$ + _
  1545.            DF$ + _
  1546.            " at " + _
  1547.            TIM$ + _
  1548.            " using " + _
  1549.            FT$ + _
  1550.            STR$(BYTES.IN.FILE#)
  1551.       CALL UPDTCALR (Z$,2)
  1552.       CALL CHECKRATIO (FALSE)
  1553.       IF BATCH.TRANSFER THEN _
  1554.          Q = Q - 1 : _
  1555.          GOTO 21772
  1556. 21774 IF MENU.INDEX = 6 THEN _
  1557.          IF DOWNLOAD.COMPLETED THEN _
  1558.             A$ = X$ : _
  1559.             SUBROUTINE.PARAMETER = 5 : _
  1560.             CALL LIBRARY
  1561.       RETURN
  1562. '
  1563. ' *****   TURN ON INTERMEDIATE ECHO   ****
  1564. '
  1565. '  (formerly line 50620 in RBBS-PC.BAS CPC16-1A
  1566. 21780 IF ECHOER$ = "I" THEN _
  1567.          CALL SETECHO ("I")
  1568. '
  1569. ' *  RESTORE COMMUNICATIONS AFTER SWITCH TO 8 BIT
  1570. '
  1571. '  (formerly between lines 50620 and 50630 in RBBS-PC.BAS CPC16-1A
  1572.       IF SWITCHED.TO.EIGHT THEN _
  1573.          IF SWITCH.BACK THEN _
  1574.             OUT LINE.CONTROL.REGISTER, PREV.LINE.CONTROL : _
  1575.             CALL DELAYIT (3) : _
  1576.             EIGHT.BIT = FALSE : _
  1577.             SWITCHED.TO.EIGHT = FALSE
  1578.       RETURN
  1579. '
  1580. ' *****  TURN OFF INTERMEDIATE ECHO  ****
  1581. '
  1582. '  (formerly line 50630 in RBBS-PC.BAS CPC16-1A
  1583. 21790 IF ECHOER$ = "I" THEN _
  1584.          CALL SETECHO ("R")
  1585.       RETURN
  1586. '
  1587. ' *****   DIRECTORY SEARCH   ****
  1588. '
  1589. '  (formerly lines 52900 to 52920 in RBBS-PC.BAS CPC16-1A
  1590. 21800 CK = 2
  1591.       IF Q > 1 THEN _
  1592.          GOTO 21820
  1593. 21810 A$ = "Search for (in file name/desc, wildcards name only, [ENTER] quits)"
  1594.       MACRO.MIN = 99
  1595.       GOSUB 21660
  1596.       IF FILESYS.PARAMETER > 1 THEN _
  1597.          RETURN
  1598.       IF Q = 0 THEN _
  1599.          RETURN
  1600.       B$(2) = B$(1)
  1601. 21820 RS$ = B$(2)
  1602.       WILD.SEARCH = (INSTR(RS$,"*") > 0 OR INSTR(RS$,"?") > 0)
  1603.       CALL ALLCAPS (RS$)
  1604.       SEARCH.STRING$ = RS$
  1605.       SEARCH.DATE$ = ""
  1606.       A1$ = RS$
  1607.       GOTO 21867
  1608. '
  1609. ' *****  P - personal download  ****
  1610. '
  1611. '  (formerly lines 52950 to 52952 in RBBS-PC.BAS CPC16-1A
  1612. 21850 IF PERSONAL.BEGIN < 1 OR PERSONAL.LEN < 1 THEN _
  1613.          RETURN
  1614.       DOWNLOAD.FLAG = 0
  1615.       PERSONAL.DOWNLOAD = TRUE
  1616. 21852 CALL PERSFILE (MID$(USER.RECORD$,PERSONAL.BEGIN,PERSONAL.LEN),_
  1617.                      DOWNLOAD.FLAG)
  1618.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1619.          FILESYS.PARAMETER = 7: _
  1620.          RETURN
  1621.       IF Q <= 0 THEN _
  1622.          GOTO 21854
  1623.       CONCAT.FILES = PERSONAL.CONCAT
  1624.       STOP.INTERRUPTS = TRUE
  1625.       TIME.LOCK.EXEMPT = TRUE
  1626.       GOSUB 20202
  1627.       IF FILESYS.PARAMETER > 1 THEN _
  1628.          GOTO 21854
  1629.       TIME.LOCK.EXEMPT = FALSE
  1630.       CONCAT.FILES = FALSE
  1631.       GOTO 21852
  1632. 21854 PERSONAL.DOWNLOAD = FALSE
  1633.       RETURN
  1634. '
  1635. ' *  N - COMMAND FROM FILES MENU (DISPLAY NEW FILES SINCE LAST DIR DISPLAY)
  1636. '
  1637. '  (formerly lines 53000 to 53070 in RBBS-PC.BAS CPC16-1A
  1638. 21860 CK = 1
  1639.       IF Q > 1 THEN _
  1640.          GOTO 21865
  1641. 21862 A1$ = RIGHT$(LM$,4) +_
  1642.             LEFT$(LM$,2)
  1643.       A$ = "Files on/after (MMDDYY, [ENTER] = last on " + _
  1644.            A1$ + _
  1645.            ")"
  1646.       GOSUB 21660
  1647.       IF FILESYS.PARAMETER > 1 THEN _
  1648.          RETURN
  1649.       IF Q = 0 THEN _
  1650.          RS$ = LM$ : _
  1651.          GOTO 21866
  1652.       B$(2) = B$(1)
  1653. 21865 IF LEN(B$(2)) <> 6 THEN _
  1654.          GOTO 21862
  1655.       A1$ = B$(2)
  1656.       RS$ = RIGHT$(A1$,2) + _
  1657.             LEFT$(A1$,4)
  1658. 21866 SEARCH.DATE$ = RS$
  1659.       SEARCH.STRING$ = ""
  1660. 21867 IF Q > 2 THEN _
  1661.          DIR.INDEX = 3 : _
  1662.          GOTO 21871
  1663. 21870 CALL GETDIRS (NOT EXPERT.USER)
  1664.       IF Q = 0 THEN _
  1665.          RETURN
  1666.       DIR.INDEX = 1
  1667. 21871 CALL CONVDIRS (DIR.INDEX)
  1668.       LAST.DIR.POS = Q
  1669.       LIST.DIRECTORY = TRUE
  1670.       LIST.NEW = TRUE
  1671. 21875 Z$ = B$(DIR.INDEX)
  1672.       IF Z$ = "ALL" THEN _
  1673.          IF NOT LIMIT.SEARCH.TO.FMS THEN _
  1674.             GOTO 21890
  1675. 21880 LIST.INDEX = DIR.INDEX
  1676.       QX = LIST.INDEX
  1677.       GOSUB 20160
  1678.       IF FILESYS.PARAMETER > 1 THEN _
  1679.          RETURN
  1680.       DIR.INDEX = DIR.INDEX + 1
  1681.       IF DIR.INDEX <= LAST.DIR.POS THEN _
  1682.          GOTO 21875
  1683.       LIST.NEW = FALSE
  1684.       SEARCH.STRING$ = ""
  1685.       SEARCH.DATE$ = ""
  1686.       RETURN
  1687. 21890 G = DIR.INDEX
  1688.       LIST.INDEX = DIRECTORY.INDEX + 1
  1689.       CALL GETALL (DIRECTORY.PATH$ + DIRECTORY.PREFIX$ + "." + DIRECTORY.EXTENTION$,B$(),DIRECTORY.EXTENTION$,G)
  1690.       SEARCHING.ALL = TRUE
  1691.       QX = G
  1692.       LIST.INDEX = DIR.INDEX + 1
  1693.       GOTO 20160
  1694. '
  1695. ' *  MAIN FILE SYSTEM ERROR TRAP - ALL ERRORS PASS THROUGH THIS ROUTINE
  1696. '
  1697. '  (formerly lines 13000 to 13500 in RBBS-PC.BAS CPC16-1A
  1698. 21900 IF DEBUG THEN _
  1699.          A$ = "RBBSSUB5 DEBUG Error Trap Entry ERL=" + _
  1700.               STR$(EL) + _
  1701.               " ERR=" + _
  1702.               STR$(EC) : _
  1703.          IF PRINTER THEN _
  1704.             CALL PRINTIT(A$) _
  1705.          ELSE CALL LPRNT(A$,1)
  1706.       IF EL = 20126 AND EC = 53 THEN _
  1707.          GOTO 20142
  1708.       IF EL = 20242 AND EC = 62 THEN _
  1709.          CALL UPDTCALR (FILESEC.FILE$ + " bad format!",2) : _
  1710.          GOTO 20247
  1711.       IF EL = 20262 THEN _
  1712.          A$ = "<Download aborted>" : _
  1713.          DOWNLOAD.COMPLETED = FALSE : _
  1714.          GOTO 20390
  1715.       IF EL = 20452 AND EC = 53 THEN _
  1716.          GOTO 20451
  1717.       IF EL = 20560 AND EC = 67 THEN _
  1718.          GOTO 20451
  1719.       IF EL = 20560 AND EC = 70 THEN _
  1720.          IF VAL(FREE.SPACE$) > 1999 THEN _
  1721.             GOTO 20610 _
  1722.          ELSE CALL QTPUT1 ("No room for uploads. Try tomorrow.") : _
  1723.               GOTO 21700
  1724.       IF EL = 20620 THEN _
  1725.          GOTO 20670
  1726.       IF EL = 20650 THEN _
  1727.          GOTO 20670
  1728.       IF EL = 20736 AND EC = 53 THEN _
  1729.          GOTO 21700
  1730.       IF EL = 20900 AND EC = 75 THEN _
  1731.          GOTO 21230
  1732.       IF EL = 20900 AND EC = 70 THEN _
  1733.          CALL QTPUT1 ("No room for uploads. Try tomorrow.") : _
  1734.          GOTO 21230
  1735.       IF EL = 21131 OR EL = 21220 THEN _
  1736.          EC = 0 : _
  1737.          GOTO 21230
  1738.       IF EL = 21480 THEN _
  1739.          CALL LOGERROR : _
  1740.          IF EC = 57 THEN _
  1741.             CALL QTPUT1 ("Error reading file.  Aborting download") : _
  1742.             DOWNLOAD.COMPLETED = FALSE : _
  1743.             GOTO 21230
  1744. 21910 CALL LOGERROR
  1745.       CALL QTPUT1 (CALLERS.RECORD$)
  1746.       FILESYS.PARAMETER = 3
  1747.       RETURN
  1748. 21920 ' EXIT RBBS-PC FILE SUBSYSTEM
  1749.       END SUB
  1750. 63100 ' $SUBTITLE: 'DOORRTN - Subroutine to process requests from a door'
  1751. ' $PAGE
  1752. '
  1753. '  NAME    -- DOORRTN
  1754. '
  1755. '  INPUTS  -- PARAMETER                      MEANING
  1756. '             DOUTx.DEF               File of requests
  1757. '
  1758. '  OUTPUTS -- USER.SECURITY.LEVEL     Revised Security Level
  1759. '
  1760. '  PURPOSE -- To give Doors a stable way to make requests
  1761. '             to the host.
  1762. '
  1763.       SUB DOORRTN STATIC
  1764.       IF PRIVATE.DOOR OR NOT EXIT.TO.DOORS THEN _
  1765.          EXIT SUB
  1766.       FILE.NAME$ = "DOUT" + NODE.ID$ + ".DEF"
  1767.       CALL FINDIT (FILE.NAME$)
  1768.       IF NOT OK THEN _
  1769.          EXIT SUB
  1770. 63105 IF EOF(2) THEN _
  1771.          GOTO 63195
  1772.       CALL READPARMS (A$(),2,1)
  1773.       IF EC > 0 THEN _
  1774.          GOTO 63115
  1775.       IF LEN(A$(1)) < 2 THEN _
  1776.          EXIT SUB
  1777.       B$ = LEFT$(A$(1),2) + ","
  1778.       X = INSTR("SL,UR,",B$)
  1779.       IF X = 0 THEN _
  1780.          GOTO 63105
  1781.       X = X\3 + 1
  1782.       ON X GOTO 63110,63115
  1783.       GOTO 63105
  1784. 63110 X$ = LEFT$(A$(2),1)         ' SL = Security Level
  1785.       CALL CHECKINT (A$(2))
  1786.       IF EC > 0 THEN _
  1787.          GOTO 63105
  1788.       IF X$ = "+" OR X$ = "-" THEN _
  1789.          A = USER.SECURITY.LEVEL + TESTED.INTEGER.VALUE _
  1790.       ELSE A = TESTED.INTEGER.VALUE
  1791.       IF A < SYSOP.SECURITY.LEVEL THEN _
  1792.          ADJUSTED.SECURITY = (A <> USER.SECURITY.LEVEL) : _
  1793.          IF ADJUSTED.SECURITY THEN _
  1794.             USER.SECURITY.LEVEL = A : _
  1795.             MID$(USER.RECORD$,47,2) = MKI$(A) : _
  1796.             CALL QTPUT1 ("Security changed to" + STR$(A)) : _
  1797.             CALL UPDTCALR ("Door reset security to "+STR$(A),2)
  1798.       GOTO 63105
  1799. 63115 IF LEN(A$(1)) < 7 THEN _
  1800.          GOTO 63105
  1801.       IF MID$(A$(1),3,1) <> "(" THEN _
  1802.          GOTO 63105
  1803.       X = INSTR(4,A$(1),":")
  1804.       IF X < 1 THEN _
  1805.          GOTO 63105
  1806.       CALL CHECKINT (MID$(A$(1),4,X-4))
  1807.       IF EC > 0 THEN _
  1808.          GOTO 63105
  1809.       IF TESTED.INTEGER.VALUE > 128 OR TESTED.INTEGER.VALUE < 1 THEN _
  1810.          GOTO 63105
  1811.       A = TESTED.INTEGER.VALUE
  1812.       CALL CHECKINT (MID$(A$(1),X+1))
  1813.       IF EC > 0 OR TESTED.INTEGER.VALUE < 1 OR TESTED.INTEGER.VALUE > 128 THEN _
  1814.          GOTO 63105
  1815.       MID$(USER.RECORD$,A,TESTED.INTEGER.VALUE) = LEFT$(A$(2) + _
  1816.          SPACE$(TESTED.INTEGER.VALUE),TESTED.INTEGER.VALUE)
  1817.       CALL UPDTCALR ("Door set UR"+STR$(A)+":"+STR$(TESTED.INTEGER.VALUE)+" to <"+A$(2)+">",2)
  1818.       GOTO 63105
  1819. 63195 CALL KILLWORK (FILE.NAME$)
  1820.       EC = 0
  1821.       END SUB
  1822. 63200 ' $SUBTITLE: 'WILDCARD -- Matches string to a pattern'
  1823. ' $PAGE
  1824. '  NAME    -- WILDCARD
  1825. '
  1826. '  INPUTS  -- PARAMETER             MEANING
  1827. '             PATTERN$           PATTERN TO CHECK
  1828. '             STRNG$             STRING TO FIE
  1829. '
  1830. '  OUTPUTS -- OK                 TRUE IF MATCH FOUND
  1831. '                                FALSE IF NO MATCH WAS FOUND
  1832. '
  1833. '  PURPOSE  Determine whether a string is an instance in a pattern
  1834. '           supported patterns are only "?" which requires a
  1835. '           character but can be any, and "*" which matches any-
  1836. '           thing, including a null string.  Anything else in a
  1837. '           sting must be an exact match.  Supports reverse
  1838. '           wildcards.
  1839. '
  1840. '
  1841.       SUB WILDCARD (PATTERN$,STRNG$) STATIC
  1842. 63285 OK = TRUE
  1843.       PATPOS = 0
  1844.       STRPOS = 0
  1845.       INC = 1
  1846.       KT = 0
  1847.       P = LEN(PATTERN$)
  1848.       L = LEN(STRNG$)
  1849. 63286 PATPOS = PATPOS + INC
  1850.       STRPOS = STRPOS + INC
  1851.       KT = KT + 1
  1852.       IF KT > L THEN _
  1853.          GOTO 63288
  1854.       B$ = MID$(PATTERN$,PATPOS,1)
  1855.       IF B$ = "*" THEN _
  1856.          GOTO 63289
  1857. 63287 IF B$ <> "?" AND MID$(STRNG$,STRPOS,1) <> B$ THEN _
  1858.          OK = FALSE : _
  1859.          EXIT SUB
  1860.       GOTO 63286
  1861. 63288 IF PATPOS >= LEN(PATTERN$) OR PATPOS < 1 THEN _
  1862.          EXIT SUB
  1863.       IF MID$(PATTERN$,PATPOS,1) <> "*" THEN _
  1864.          OK = FALSE : _
  1865.          EXIT SUB
  1866. 63289 IF PATPOS <> P THEN _   ' Reverse search
  1867.          INC = -1 : _
  1868.          P = PATPOS : _
  1869.          PATPOS = LEN(PATTERN$) + 1 : _
  1870.          STRPOS = LEN(STRNG$) + 1 : _
  1871.          KT = 0 : _
  1872.          GOTO 63286
  1873.       END SUB
  1874. 63300 ' $SUBTITLE: 'BRKFNAME - sub to split file name into components'
  1875. ' $PAGE
  1876. '
  1877. '  NAME    -- BRKFNAME
  1878. '
  1879. '  INPUTS  -- PARAMETER                    MEANING
  1880. '             FILENAME$        FULL NAME OF FILE
  1881. '             FOR.JOINING      TRUE IF WANT PARTS FORMATTED FOR
  1882. '                                           FORMING FILE NAMES
  1883. '  OUTPUTS -- DRVPATH$         DRIVE AND PATH
  1884. '             PREFIX$          PREFIX OF FILE NAME
  1885. '             EXTENSION$       EXTENSION OF FILE NAME
  1886. '
  1887. ' (E.G. "C:\RBBS\ARCE.COM" HAS "C:\RBBS" AS DRIVE AND PATH,
  1888. '                              "ARCE"    AS PREFIX OF THE FILE NAME, AND
  1889. '                              "COM"     AS THE EXTENSION OF THE FILE NAME.
  1890. '
  1891. ' JOINED FORMAT IS C:\RBBS\,ARCE,.COM
  1892. '
  1893. '  PURPOSE -- To break a file name into its component parts
  1894. '             of drive/path, prefix, and extension
  1895. '
  1896. '
  1897.       SUB BRKFNAME (FILENAME$,DRVPATH$,PREFIX$,EXTENSION$,FOR.JOINING) STATIC
  1898.       CALL ALLCAPS (FILENAME$)
  1899.       DRVPATH$ = ""
  1900.       PREFIX$ = ""
  1901.       EXTENSION$ = ""
  1902.       CALL TRIMTRAIL (FILENAME$,"\")
  1903.       L = LEN(FILENAME$)
  1904.       IF L < 1 THEN _
  1905.          EXIT SUB
  1906.       CALL FINDLAST (FILENAME$,"\",X,Y)
  1907.       IF X < 1 THEN _
  1908.          IF MID$(FILENAME$,2,1) = ":" THEN _
  1909.             DRVPATH$ = LEFT$(FILENAME$,1) : _
  1910.             S = 3 _
  1911.          ELSE S = 1 _
  1912.       ELSE DRVPATH$ = LEFT$(FILENAME$,X-1) : _
  1913.            S = X + 1 : _
  1914.            IF Y = 1 THEN _                                           ' KG061201
  1915.               DRVPATH$ = DRVPATH$ + "\"                              ' KG061201
  1916.       X = INSTR(FILENAME$ + ".",".")
  1917.       IF X < L THEN _
  1918.          EXTENSION$ = MID$(FILENAME$,X + 1,3)
  1919.       IF S <= L THEN _
  1920.          IF X >= S THEN _
  1921.             PREFIX$ = MID$(FILENAME$,S,X - S)
  1922.       IF NOT FOR.JOINING THEN _
  1923.          EXIT SUB
  1924.       IF LEN(DRVPATH$) = 1 THEN _
  1925.          IF DRVPATH$ <> "\" THEN _                                   ' KG061201
  1926.             DRVPATH$ = DRVPATH$ + _                                  ' KG061201
  1927.                        ":"                                           ' KG061201
  1928.       IF INSTR(DRVPATH$,"\") > 0 AND RIGHT$(DRVPATH$,1) <> "\" THEN _ ' KG061201
  1929.          DRVPATH$ = DRVPATH$ + _
  1930.                     "\"
  1931.       IF LEN(EXTENSION$) > 0 THEN _
  1932.          EXTENSION$ = "." + _
  1933.                       EXTENSION$
  1934.       END SUB
  1935. 63310 ' $SUBTITLE: 'RESTORECOM - sub to restore comm port'
  1936. ' $PAGE
  1937. '
  1938. '  NAME    -- RESTORECOM
  1939. '
  1940. '  INPUTS  -- none
  1941. '
  1942. '  OUTPUTS -- none
  1943. '
  1944. '  PURPOSE -- To restore communications port after an external
  1945. '             program may have left it in altered state
  1946. '
  1947.       SUB RESTORECOM STATIC
  1948.       PARITY$ = MID$(",N,8,1,E,7,1",7 + 6 * EIGHT.BIT,6)
  1949.       IF LOCAL.USER THEN _
  1950.          EXIT SUB
  1951.       CALL SETBAUD                                                   ' KG052102
  1952.       IF NOT FOSSIL THEN _                                           ' KG052102
  1953.          CALL OPENCOM(TALK.TO.MODEM.AT$,PARITY$)
  1954.       END SUB
  1955. 63320 ' $SUBTITLE: 'SHELLEXIT - sub to shell out from RBBS'
  1956. ' $PAGE
  1957. '
  1958. '  NAME    -- SHELLEXIT
  1959. '
  1960. '  INPUTS  -- SHELL.TEM$     String to invoke shell with
  1961. '
  1962. '  OUTPUTS -- none
  1963. '
  1964. '  PURPOSE -- Delay so that strings can finish printing.  Restore comm
  1965. '             port on return
  1966. '
  1967.       SUB SHELLEXIT (SHELL.TEM$) STATIC
  1968.       CALL DELAYIT (8 + BPS)
  1969.       IF FOSSIL THEN _
  1970.          CALL FOSEXIT(COMPORT%) _
  1971.       ELSE CLOSE 3 : _
  1972.            OUT MODEM.CONTROL.REGISTER,INP(MODEM.CONTROL.REGISTER) OR 1
  1973.       CLOSE 2
  1974.       CALL METAGSR (SHELL.TEM$,FALSE)
  1975.       SHELL SHELL.TEM$
  1976.       IF FOSSIL THEN _
  1977.          CALL FOSINIT(COMPORT%,RESULT%) : _
  1978.          IF RESULT% = -1 THEN _
  1979.             CALL PSCRN("ERROR INITIALIZING FOSSIL AFTER EXTERNAL PROTOCOL") : _
  1980.             SYSTEM
  1981.       CALL DELAYIT (2)
  1982.       CALL RESTORECOM
  1983.       END SUB
  1984. 63330 ' $SUBTITLE: 'READMACRO - sub to read macro'
  1985. ' $PAGE
  1986. '
  1987. '  NAME    -- READMACRO
  1988. '
  1989. '  INPUTS  -- PARAMETER             MEANING
  1990. '
  1991. '  OUTPUTS -- A$               LINE TO PROCESS IN MACRO
  1992. '             MACRO.ACTIVE     FLAG WHETHER IN A MACRO
  1993. '
  1994. '  PURPOSE -- Reads in a line from macro file (#6) and processes
  1995. '             macro commands, which are:
  1996. '             *0 - display what follows, no carriage return
  1997. '             *1 - display what follows with carriage return
  1998. '             *B - display block that follows
  1999. '             *F - display File
  2000. '             WT - wait specified # of seconds
  2001. '             >> - append following block to specified file
  2002. '             ST - stack following (with carriage return)
  2003. '             ON - define case
  2004. '             == - case value that applies to following block
  2005. '             M! - execute following macro
  2006. '             M@ - abort macro processing
  2007. '             EY - Echo on (yes)
  2008. '             EN - Echo off (no)
  2009. '             /* - comment line skipped in processing
  2010. '             TK - Turbo key on (if user preference)
  2011. '             << - Read from file into a form
  2012. '
  2013.       SUB READMACRO STATIC
  2014.       IF MACRO.TEMPLATE$ <> "" THEN _
  2015.          GOTO 63392
  2016.       IF DISTANT.TGET = 2 THEN _
  2017.          GOTO 63349
  2018. 63336 GOSUB 63395
  2019.       IF NOT MACRO.ACTIVE THEN _
  2020.          MACRO.ECHO = TRUE : _
  2021.          EXIT SUB
  2022.       IF LEN(A$) < 3 THEN _
  2023.          GOTO 63398
  2024.       X$ = RIGHT$(A$,LEN(A$)-3)
  2025.       IF COMPARE.VAR > 0 THEN _
  2026.          IF NOT CASE.EXECUTE THEN _
  2027.             IF LEFT$(A$,3) = SMART.TEXT$+"==" THEN _
  2028.                GOTO 63370 _
  2029.             ELSE IF LEFT$(A$,7) = "{END ON" THEN _
  2030.                     COMPARE.VAR = 0 : _
  2031.                     GOTO 63336 _
  2032.                   ELSE GOTO 63336
  2033.       IF LEFT$(A$,1) <> SMART.TEXT$ THEN _
  2034.          GOTO 63398
  2035.       CALL CHECKINT (MID$(A$,2))
  2036.       IF EC > 0 THEN _
  2037.          GOTO 63398
  2038.       IF TESTED.INTEGER.VALUE > 0 AND TESTED.INTEGER.VALUE <= MAX.WORK.VAR THEN _
  2039.          A$ = X$ : _  ' Macro command ask
  2040.          SUBROUTINE.PARAMETER = 4 : _
  2041.          CALL TPUT : _
  2042.          A$ = "" : _
  2043.          B$ = "" :_
  2044.          FORCE.KEYBOARD = TRUE : _
  2045.          MACRO.SAVE = TESTED.INTEGER.VALUE : _
  2046.          LINES.PRINTED = 1 : _
  2047.          NON.STOP = (PAGE.LENGTH < 1) : _                            ' KG072603
  2048.          EXIT SUB
  2049.       ON (1+INSTR("*0*1*B*FWT>>STON==M!M@EYEN/*TK<<",MID$(A$,2,2)))\2 GOTO _
  2050.          63345, _  ' Display with no Carriage Return
  2051.          63347, _  ' Display with Carriage Return
  2052.          63340, _  ' Display Block
  2053.          63348, _  ' Display File
  2054.          63343, _  ' Wait # of seconds
  2055.          63350, _  ' Append to file
  2056.          63355, _  ' Stack
  2057.          63360, _  ' Case
  2058.          63370, _  ' Case Comparison
  2059.          63375, _  ' Macro execute
  2060.          63380, _  ' Macro Abort
  2061.          63383, _  ' Macro Echo on
  2062.          63385, _  ' Macro Echo off
  2063.          63336, _  ' Macro Comment
  2064.          63387, _  ' Turbo Key allowed
  2065.          63390     ' Form read
  2066.       GOTO 63398
  2067. 63338 A$ = X$
  2068. 63339 SUBROUTINE.PARAMETER = 4                                       ' KG062803
  2069.       CALL TPUT
  2070.       RETURN
  2071. 63340 X$ = SMART.TEXT$ + "END"  ' Print Block
  2072.       GOSUB 63395
  2073.       WHILE MACRO.ACTIVE AND LEFT$(A$,4) <> X$
  2074.          GOSUB 63339
  2075.          CALL SKIPLINE (1)
  2076.          GOSUB 63395
  2077.       WEND
  2078.       GOTO 63336
  2079. 63343 CALL CHECKINT (X$)      ' Delay
  2080.       IF EC = 0 THEN _
  2081.          CALL DELAYIT (TESTED.INTEGER.VALUE)
  2082.       GOTO 63336
  2083. 63345 GOSUB 63338               ' Print Line
  2084.       GOTO 63336
  2085. 63347 GOSUB 63338
  2086.       CALL SKIPLINE (1)
  2087.       GOTO 63336
  2088. 63348 CALL TRIM (X$)            ' Print File
  2089.       CALL FINDITX (X$,7)                                            ' KG061001
  2090.       IF NOT OK THEN _
  2091.          GOTO 63336
  2092.       LINES.PRINTED = 1
  2093.       NO = FALSE                                                     ' KG071902
  2094.       NON.STOP = (NON.STOP OR PAGE.LENGTH < 1)                       ' KG060401
  2095. 63349 WHILE (NOT EOF(7) AND (NOT NO) AND (NON.STOP OR (LINES.PRINTED < PAGE.LENGTH)) AND (SUBROUTINE.PARAMETER > -1)) ' KG071904
  2096.          CALL READDIR (7,1)                                          ' KG061001
  2097.          GOSUB 63396                                                 ' KG060401
  2098.          SUBROUTINE.PARAMETER = 5
  2099.          CALL TPUT
  2100.       WEND
  2101.       DISTANT.TGET = 0
  2102.       IF SUBROUTINE.PARAMETER < 0 THEN _
  2103.          EXIT SUB
  2104.       IF EOF(7) OR NO THEN _                                         ' KG061001
  2105.          CLOSE 7 : _                                                 ' KG061001
  2106.          NO = FALSE : _                                              ' KG061001
  2107.          GOTO 63336
  2108.       DISTANT.TGET = 2
  2109.       CALL PAUSEEXIT
  2110.       EXIT SUB
  2111. 63350 EN$ = X$            ' Append to file
  2112.       X = INSTR(EN$," /FL")
  2113.       OVERSTRIKE = (X > 0)
  2114.       IF OVERSTRIKE THEN _
  2115.          EN$ = LEFT$(EN$,X-1) + RIGHT$(EN$,LEN(EN$)-X-3)
  2116.       CALL TRIM (EN$)
  2117.       CALL LOCKAPPND
  2118.       IF EC > 0 THEN _
  2119.          GOTO 63352
  2120.       GOSUB 63395
  2121.       X$ = SMART.TEXT$ + "END"
  2122.       WHILE MACRO.ACTIVE AND LEFT$(A$,4) <> X$                       ' KG062803
  2123.          CALL PRNTWRKA (A$)
  2124.          GOSUB 63395
  2125.       WEND
  2126. 63352 CALL UNLKAPPND
  2127.       OVERSTRIKE = FALSE
  2128.       GOTO 63336
  2129. 63355 COMMPORT.STACK$ = COMMPORT.STACK$ + X$ + CARRIAGE.RETURN$ ' STack
  2130.       GOTO 63336
  2131. 63360 COMPARE.VAR = VAL(X$)
  2132.       CALL ALLCAPS (X$)                                              ' KG062901
  2133.       IF COMPARE.VAR < 1 OR COMPARE.VAR > MAX.WORK.VAR THEN _
  2134.          COMPARE.VAR = 0
  2135.       GOTO 63336
  2136. 63370 IF COMPARE.VAR = 0 THEN _     ' Compare Case
  2137.          GOTO 63336
  2138.       DF$ = GSR.ARA$(COMPARE.VAR)
  2139.       CALL ALLCAPS (DF$)
  2140.       CASE.EXECUTE = (X$ = DF$)
  2141.       GOTO 63336
  2142. 63375 CALL TRIM (X$)           ' Execute Macro
  2143.       CALL CHKMACRO (X$,X)
  2144.       GOTO 63336
  2145. 63380 MACRO.ACTIVE = FALSE     ' Abort Macro
  2146.       GOTO 63398
  2147. 63383 MACRO.ECHO = TRUE
  2148.       GOTO 63336
  2149. 63385 MACRO.ECHO = FALSE
  2150.       GOTO 63336
  2151. 63387 TURBO.KEY = -TURBO.KEY.USER   'TK Turbo Key
  2152.       GOTO 63336
  2153. 63390 B$ = A$
  2154.       B$(5) = ""
  2155.       B$(6) = ""
  2156.       Q = 1
  2157.       CALL PARSEIT
  2158.       IF Q < 4 THEN _
  2159.          GOTO 63336
  2160.       X$ = SMART.TEXT$ + "END"
  2161.       GOSUB 63395
  2162.       MACRO.TEMPLATE$ = ""
  2163.       WHILE MACRO.ACTIVE AND LEFT$(A$,4) <> X$
  2164.          MACRO.TEMPLATE$ = MACRO.TEMPLATE$ + A$ + CRLF$
  2165.          GOSUB 63395
  2166.       WEND
  2167.       X = VAL(B$(4))
  2168.       VAR.LEN = (B$(3) <> "/F")
  2169.       CALL FINDIT (B$(2))
  2170.       IF (X < 1) OR (NOT OK) OR (VAR.LEN AND X > MAX.WORK.VAR) THEN _
  2171.          MACRO.TEMPLATE$ = "" : _
  2172.          GOTO 63336
  2173. 63392 CALL FORMREAD (MACRO.TEMPLATE$,B$(2),NOT VAR.LEN,X,(B$(5) = "/FL"),(B$(6) = "/1"))
  2174.       IF MACRO.TEMPLATE$ <> "" THEN _
  2175.          EXIT SUB _
  2176.       ELSE GOTO 63336
  2177. 63395 IF EOF(6) THEN _         ' Read next line in macro
  2178.          MACRO.ACTIVE = FALSE _
  2179.       ELSE CALL READDIR (6,1) : _
  2180.            GOSUB 63396 : _                                           ' KG062803
  2181.            MACRO.ACTIVE = (EC = 0)
  2182.       RETURN
  2183. 63396 CALL SMARTTXT (A$,FALSE, OVERSTRIKE)
  2184.       CALL METAGSR (A$,OVERSTRIKE)
  2185.       RETURN
  2186. 63397
  2187. 63398 END SUB    ' Not Macro command - pass to normal processing
  2188. 63400 ' $SUBTITLE: 'LOCKAPPND - prepares for file append'
  2189. ' $PAGE
  2190. '
  2191. '  NAME    -- LOCKAPPND
  2192. '
  2193. '  INPUTS  -- EN$            Name of file to append to
  2194. '
  2195. '  OUTPUTS -- none
  2196. '
  2197. '  PURPOSE -- Locks and opens file to append to
  2198. '
  2199.       SUB LOCKAPPND STATIC
  2200.       BX = &H4
  2201.       SUBROUTINE.PARAMETER = 9
  2202.       CALL FILELOCK
  2203.       EC = 0
  2204.       CALL OPENWRKA (EN$)
  2205.       END SUB
  2206. 63410 ' $SUBTITLE: 'UNLKAPPND - cleans up after file append'
  2207. ' $PAGE
  2208. '
  2209. '  NAME    -- UNLKAPPND
  2210. '
  2211. '  INPUTS  -- none
  2212. '
  2213. '  OUTPUTS -- none
  2214. '
  2215. '  PURPOSE -- Unlocks and close file appending to
  2216. '
  2217.       SUB UNLKAPPND STATIC
  2218.       BX = &H4
  2219.       SUBROUTINE.PARAMETER = 10
  2220.       CALL FILELOCK
  2221.       CLOSE 2
  2222.       END SUB
  2223. 63420 ' $SUBTITLE: 'FORMREAD - Reads from a file into a form'
  2224. ' $PAGE
  2225. '
  2226. '  NAME    -- FORMREAD
  2227. '
  2228. '  INPUTS  -- TEMPLATE$      Display formvoke shell with
  2229. '             FILNAME$       Data file to get values from
  2230. '             FIXED.LENGTH   Whether file is fixed length
  2231. '             DATA.VAR       # bytes data if fixed length; # fields
  2232. '                              if variable length
  2233. '             OVERSTRIKE     Whether typeover into form or insert
  2234. '             REC.PAUSE      Whether pause after every record displayed
  2235. '                               otherwise when screen fills
  2236. '  OUTPUTS -- (displays data base records)
  2237. '
  2238. '  PURPOSE -- Allows field oriented data base data to be displayed
  2239. '               in a human readable format by substituting field
  2240. '               data into template or form
  2241. '
  2242.       SUB FORMREAD (TEMPLATE$,FILNAME$,FIXED.LENGTH,DATA.VAR,OVERSTRIKE,REC.PAUSE) STATIC
  2243. 63422 IF EOF(2) OR NO OR (EC > 0) OR (SUBROUTINE.PARAMETER < 0) THEN _
  2244.          TEMPLATE$ = "" : _
  2245.          EXIT SUB
  2246.       IF FIXED.LENGTH THEN _
  2247.          CALL READDIR (2,1) : _
  2248.          GSR.ARA$(1) = A$ _
  2249.       ELSE CALL READPARMS (GSR.ARA$(),DATA.VAR,1)
  2250.       X$ = TEMPLATE$
  2251.       CALL SMARTTXT (X$,TRUE,OVERSTRIKE)
  2252.       CALL METAGSR (X$,OVERSTRIKE)
  2253.       CALL BUFASUNIT (X$)
  2254.       IF REC.PAUSE OR (PAGE.LENGTH > 0 AND (LINES.PRINTED >= PAGE.LENGTH-1)) THEN _
  2255.          CALL PAUSEEXIT : _
  2256.          EXIT SUB
  2257.       GOTO 63422
  2258.       END SUB
  2259. 63440 ' $SUBTITLE: 'BUFASUNIT - prints string with no pauses'
  2260. ' $PAGE
  2261. '
  2262. '  NAME    -- BUFASUNIT
  2263. '
  2264. '  INPUTS  -- STRNG$     String to print
  2265. '
  2266. '  OUTPUTS -- none
  2267. '
  2268. '  PURPOSE -- Prints string with embedded carriage returns.
  2269. '             Will never pause.  Used to print when can't call TGET
  2270. '
  2271.       SUB BUFASUNIT (STRNG$) STATIC
  2272.       L = LEN(STRNG$)
  2273.       IF L < 1 THEN _
  2274.          EXIT SUB
  2275.       START.BYTE = 1
  2276. 63450 CRAT = INSTR(START.BYTE,STRNG$,CARRIAGE.RETURN$)
  2277.       IF CRAT > 0 AND CRAT < L THEN _
  2278.          CR.FOUND = (MID$(STRNG$,CRAT + 1,1) = LINE.FEED$) _
  2279.       ELSE CR.FOUND = FALSE
  2280.       EOL.LEN = -2 * CR.FOUND
  2281.       IF CR.FOUND THEN _
  2282.          EOD = CRAT _
  2283.       ELSE EOD = L + 1
  2284.       NUM.BYTES = EOD - START.BYTE
  2285.       A$ = MID$(STRNG$,START.BYTE,NUM.BYTES)
  2286.       SUBROUTINE.PARAMETER = 4
  2287.       CALL TPUT
  2288.       CALL SKIPLINE (-(CR.FOUND))
  2289.       IF RET THEN _
  2290.          EXIT SUB
  2291.       START.BYTE = EOD + EOL.LEN
  2292.       IF START.BYTE <= L THEN _
  2293.          GOTO 63450
  2294.       END SUB
  2295. 63460 SUB MACROEXE (STRNG$) STATIC
  2296.       CALL TRIM (STRNG$)
  2297.       CALL FINDIT (STRNG$)
  2298.       IF NOT OK THEN _
  2299.          EXIT SUB
  2300.       COMMPORT.STACK$ = COMMPORT.STACK$ + STRNG$ + CARRIAGE.RETURN$
  2301.       CALL FDMACEXE
  2302.       END SUB
  2303. 63462 SUB FDMACEXE STATIC
  2304.       A$ = ""
  2305.       MACRO.ECHO = FALSE
  2306.       SUBROUTINE.PARAMETER = 4
  2307.       CALL TGET
  2308.       END SUB
  2309. 63465 SUB PAUSEEXIT STATIC
  2310.       ' CALL SKIPLINE (1)
  2311.       SUBROUTINE.PARAMETER = 4
  2312.       TURBO.KEY = -TURBO.KEY.USER
  2313.       A$ = MORE.PROMPT$ + ">" + MID$("? ! ",2*TURBO.KEY+1,2)
  2314.       FORCE.KEYBOARD = TRUE
  2315.       NO.ADVANCE = TRUE
  2316.       CALL TPUT
  2317.       LINES.PRINTED = 0
  2318.       B$ = ""                                                        ' KG060401
  2319.       END SUB
  2320. 63470 ' $SUBTITLE: 'CALLOPT - sub to set prompts based on user security'
  2321. ' $PAGE
  2322. '
  2323. '  NAME    -- CALLOPT
  2324. '
  2325. '  INPUTS  -- PARAMETER           MEANING
  2326. '             BEG.MAIN          POSITION START OF MAIN CMDS
  2327. '             BEG.FILE          POSITION START OF FILE CMDS
  2328. '             BEG.UTIL          POSITION START OF UTIL CMDS
  2329. '             BEG.LIBRARY       POSITION START OF LIBRARY CMDS
  2330. '
  2331. '  OUTPUTS -- PRESENT.OPTS$         DISPLAY WHAT USER CAN DO (1st)
  2332. '             CALLERS.OPTS$         DISPLAY WHAT USER CAN DO (2nd)
  2333. '             MAIN.OPTS$            MAIN OPTS USER CAN DO
  2334. '             FILE.OPTS$            FILE OPTS USER CAN DO
  2335. '             UTIL.OPTS$            UTIL OPTS USER CAN DO
  2336. '             LIBRARY.OPTS$         LIBRARY OPTS USER CAN DO
  2337. '
  2338. '  PURPOSE -- Sets command line display of what user can do by
  2339. '             section and display of what all user can do
  2340. '
  2341.       SUB CALLOPT STATIC
  2342.       FIRST = BEG.MAIN
  2343.       LAST = BEG.FILE - 1
  2344.       CALL SETOPTS (MAIN.OPTS$,INVALID.MAIN.OPTS$,FIRST,LAST)
  2345.       FIRST = BEG.FILE
  2346.       LAST = BEG.UTIL - 1
  2347.       CALL SETOPTS (FILE.OPTS$,INVALID.FILE.OPTS$,FIRST,LAST)
  2348.       FIRST = BEG.UTIL
  2349.       LAST = BEG.LIBRARY - 1
  2350.       CALL SETOPTS (UTIL.OPTS$,INVALID.UTIL.OPTS$,FIRST,LAST)
  2351.       FIRST = BEG.LIBRARY
  2352.       LAST = BEG.LIBRARY + 6
  2353.       CALL SETOPTS (LIBRARY.OPTS$,INVALID.LIBRARY.OPTS$,FIRST,LAST)
  2354.       FIRST = 50
  2355.       LAST = 56
  2356.       CALL SETOPTS (SYS.OPTS$,INVALID.SYS.OPTS$,FIRST,LAST)
  2357.       FIRST = 46
  2358.       LAST = 49
  2359.       CALL SETOPTS (GLOBAL.OPTS$,INVALID.GLOBAL.OPTS$,FIRST,LAST)
  2360.       IF LEN(SYS.OPTS$) > 0 THEN _
  2361.          SYSTEM.OPTS$ = "Sysop: " + _
  2362.                         SYS.OPTS$
  2363.       MAIN.OPTS$ = GLOBAL.OPTS$ + _
  2364.                    MAIN.OPTS$
  2365.       FILE.OPTS$ = GLOBAL.OPTS$ + _
  2366.                    FILE.OPTS$
  2367.       UTIL.OPTS$ = GLOBAL.OPTS$ + _
  2368.                    UTIL.OPTS$
  2369.       LIBRARY.OPTS$ = GLOBAL.OPTS$ + _
  2370.                       LIBRARY.OPTS$
  2371.       CALL SRTSTRNG (SYS.OPTS$)
  2372.       CALL SRTSTRNG (MAIN.OPTS$)
  2373.       MAIN.OPTS$ = MAIN.OPTS$ + _
  2374.                    SYS.OPTS$
  2375.       CALL SRTSTRNG (FILE.OPTS$)
  2376.       CALL SRTSTRNG (UTIL.OPTS$)
  2377.       CALL SRTSTRNG (LIBRARY.OPTS$)
  2378.       CALL INSCOMMA (MAIN.OPTS$)
  2379.       CALL INSCOMMA (FILE.OPTS$)
  2380.       CALL INSCOMMA (UTIL.OPTS$)
  2381.       CALL INSCOMMA (LIBRARY.OPTS$)
  2382.       DIR.PROMPT$ = "What directory(s) (" + _
  2383.          MID$("U)pload,A)ll,L)ist,E)xtended +/-, [Q]uit)",8 * (USER.SECURITY.LEVEL => MIN.SEC.TO.VIEW) + 9)
  2384.       QUIT.PROMPT.EXPERT$ = "QUIT C,S, or to F,[M],U,@"
  2385.       QUIT.PROMPT.NOVICE$ = "QUIT C)onference, S)ession or to section " + _
  2386.                             "F)ile, [M]ain, U)til or @)Library"
  2387.       QUIT.LIST$ = "FMUS@C"
  2388.       IF USER.SECURITY.LEVEL < OPT.SEC(18) THEN _
  2389.          QUIT.PROMPT.EXPERT$ = LEFT$(QUIT.PROMPT.EXPERT$,23) : _
  2390.          QUIT.PROMPT.NOVICE$ = LEFT$(QUIT.PROMPT.NOVICE$,61) : _
  2391.          MID$(QUIT.LIST$,5) = " "
  2392.       IF USER.SECURITY.LEVEL < OPT.SEC(15) THEN _
  2393.          QUIT.PROMPT.EXPERT$ = LEFT$(QUIT.PROMPT.EXPERT$,22) + _
  2394.                                MID$(QUIT.PROMPT.EXPERT$,25) : _
  2395.          QUIT.PROMPT.NOVICE$ = LEFT$(QUIT.PROMPT.NOVICE$,56) + _
  2396.                                MID$(QUIT.PROMPT.NOVICE$,63) : _
  2397.          MID$(QUIT.LIST$,3,1) = " "
  2398.       IF USER.SECURITY.LEVEL < OPT.SEC(6) THEN _
  2399.          QUIT.PROMPT.EXPERT$ = LEFT$(QUIT.PROMPT.EXPERT$,16) + _
  2400.                                MID$(QUIT.PROMPT.EXPERT$,19) : _
  2401.          QUIT.PROMPT.NOVICE$ = LEFT$(QUIT.PROMPT.NOVICE$,41) + _
  2402.                                MID$(QUIT.PROMPT.NOVICE$,49) : _
  2403.          MID$(QUIT.LIST$,1,1) = " "
  2404.       CALL SETSECT
  2405.       END SUB
  2406. 63480 ' $SUBTITLE: 'NOPATH - detects whether string has path'
  2407. ' $PAGE
  2408. '
  2409. '  NAME    -- NOPATH
  2410. '
  2411. '  INPUTS  -- STRNG$     String to check
  2412. '
  2413. '  OUTPUTS -- HAS.NONE   True if has no path
  2414. '
  2415. '  PURPOSE -- Detects whether have path.  Used when shouldn't
  2416. '             be any
  2417. '
  2418.       SUB NOPATH (STRNG$,HAS.PATH) STATIC                            ' KG060801
  2419.       CALL BRKFNAME (STRNG$,DRVPATH$,PREFX$,EXT$,FALSE)              ' KG060801
  2420.       HAS.PATH = (DRVPATH$ <> "")                                    ' KG060801
  2421.       END SUB                                                        ' KG060801
  2422. 63490 ' $SUBTITLE: 'FINDIT - Determine whether file exists'
  2423. ' $PAGE
  2424. '
  2425. '  NAME    -- FINDIT
  2426. '
  2427. '  INPUTS  -- FILNAME$   File name to check
  2428. '
  2429. '  OUTPUTS -- OK         True if file exists.  Opened as #2 if does
  2430. '
  2431. '  PURPOSE -- Determine whether file exists and open as standard work
  2432. '             file if it does (#2)
  2433. '
  2434.       SUB FINDIT (FILNAME$) STATIC                                   ' KG061001
  2435.       CALL FINDITX (FILNAME$,2)                                      ' KG061001
  2436.       END SUB                                                        ' KG061001
  2437.